Simplifier une procédure

Le 02/12/2021 à 11:50

Bonjour à toutes et à tous

de retour, car j'ai encore besoin votre aide.

J'ai créé un tableau composé de 10 séries de 7 lignes et 22 colonnes, chaque série est séparée par une ligne de sous total.

j'ai une suite de code qui me permet de copier 10 séries 5 colonnes et 7 lignes vers un autre tableau.

Cela est très lourd et demande du temps.

Je voudrais savoir comment améliorer ce code en le simplifiant.

Exemple pour 2 séries joint.

Merci d'avance pour votre aide.

Sub copieversTlicences1()

     Application.ScreenUpdating = False

     '1 =======================================================================================================================

      ' Nom
      Worksheets(Sheets.Count).Select
       Range("B4").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B4").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C4").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C4").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V4").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D4").PasteSpecial xlPasteValues

     'Montant reçu par chèque
     Worksheets(Sheets.Count).Select
       Range("P4").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E4").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T4").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F4").PasteSpecial xlPasteValues

     ' Nom
      Worksheets(Sheets.Count).Select
       Range("B5").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B5").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C5").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C5").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V5").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D5").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P5").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E5").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T5").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F5").PasteSpecial xlPasteValues

    ' Nom
      Worksheets(Sheets.Count).Select
       Range("B6").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B6").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C6").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C6").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V6").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D6").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P6").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E6").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T6").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F6").PasteSpecial xlPasteValues

    ' Nom
      Worksheets(Sheets.Count).Select
       Range("B7").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B7").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C7").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C7").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V7").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D7").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P7").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E7").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T7").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F7").PasteSpecial xlPasteValues

    ' Nom
      Worksheets(Sheets.Count).Select
       Range("B8").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B8").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C8").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C8").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V8").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D8").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P8").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E8").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T8").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F8").PasteSpecial xlPasteValues

   ' Nom
      Worksheets(Sheets.Count).Select
       Range("B9").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B9").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C9").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C9").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V9").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D9").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P9").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E9").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T9").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F9").PasteSpecial xlPasteValues

   ' Nom
      Worksheets(Sheets.Count).Select
       Range("B10").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B10").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C10").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C10").PasteSpecial xlPasteValues

     ' Reste à recevoir
     Worksheets(Sheets.Count).Select
      Range("V10").Select
      Selection.Copy
     Sheets("Solde  a recevoir").Select
      Range("D10").PasteSpecial xlPasteValues

    'Montant reçu par chèque
    Worksheets(Sheets.Count).Select
       Range("P10").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("E10").PasteSpecial xlPasteValues

     'Montant reçu en espèce ou par chèque Vacances
      Worksheets(Sheets.Count).Select
       Range("T10").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("F10").PasteSpecial xlPasteValues

    '2 =======================================================================================================================

    ' Nom
      Worksheets(Sheets.Count).Select
       Range("B12").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("B12").PasteSpecial xlPasteValues

     'Prénom
     Worksheets(Sheets.Count).Select
       Range("C12").Select
       Selection.Copy
      Sheets("Solde  a recevoir").Select
       Range("C12").PasteSpecial xlPasteValues

ETC........

   Application.ScreenUpdating = True

 End Sub
Le 02/12/2021 à 12:12

Bonjour,

Voici le principe :

Sub copieversTlicences1()
tSrc = array("B4", "C4", "V4", "P4", "T4", "B5", ...)
tDest = array("B4", "C4", "D4", "E4", "F4", "B5", ...)
application.calculation = xlcalculationmanual
for i = lbound(tSrc) to ubound(tSrc)
    Sheets("Solde  a recevoir").Range(tDest(i)).value = Worksheets(Sheets.Count).Range(tSrc(i)).value
next i
application.calculation = xlcalculationautomatic
End Sub

Je vous laisse compléter les 2 array :

tSrc contient les adresses sources

tDest les adresses destinataires.

Ca commence à faire beaucoup d'éléments à saisir en dur dans le code quand même, une meilleure solution pourrait être envisagée...

Par ailleurs, je recommande de renommer votre feuille "Solde a recevoir" (2 ou 3 espaces) en "Solde".

Cdlt,

Le 02/12/2021 à 14:20

Bonjour 3GB

Merci pour ta réponse, mais quand je lance la macro il me demande de définir tSrc, tDest, i, il manque des tableaux pour Lbound et Ubound.

Je plane un peu.

Encore merci

Le 02/12/2021 à 19:01

Peux-tu essayer avec les variables déclarées :

Sub copieversTlicences1()
dim tSrc, tDest, i&
tSrc = array("B4", "C4", "V4", "P4", "T4", "B5", ...)
tDest = array("B4", "C4", "D4", "E4", "F4", "B5", ...)
application.calculation = xlcalculationmanual
for i = lbound(tSrc) to ubound(tSrc)
    Sheets("Solde  a recevoir").Range(tDest(i)).value = Worksheets(Sheets.Count).Range(tSrc(i)).value
next i
application.calculation = xlcalculationautomatic
End Sub

Il faut bien compléter les 2 tableaux sinon, un bug se produira fatalement.

Cdlt,

Le 03/12/2021 à 11:42

J'ai compléter les deux tableaux mais cela bug.

Sheets("Solde").Range(tDest(i)).Value = Worksheets(Sheets.Count).Range(tSrc(i)).Value

je te joins l'image de l'erreur.

image 
Sub copieversTlicences1()

Dim tSrc, tDest, i&

Application.ScreenUpdating = False

Worksheets(Sheets.Count).Select
tSrc = Array("B4", "C4", "V4", "P4", "T4", "B5", "C5", "V5", "P5", "T5", "B6", "C6", "V6", "P6", "T6", "B7", "C7", "V7", "P7", "T7", "B8", "C8", "V8", "P8", "T8", "B9", "C9", "V9", "P9", "T9", "B10", "C10", "V10", "P10", "T10", "B12", "C12", "V12", "P12", "T12", "B13", "C13", "V13", "P13", "T13", "B14", "C14", "V14", "P14", "T14", "B15", "C15", "V15", "P15", "T15", "B16", "C16", "V16", "P16", "T16", "B17", "C17", "V17", "P17", "T17", "B18", "C18", "V18", "P18", "T18", "B20", "C20", "V20", "P20", "T20", "B21", "C21", "V21", "P21", "T21", "B22", "C22", "V22", "P22", "T22", "B23", "C23", "V23", "P23", "T23", "B24", "C24", "V24", "P24", "T24", "B25", "C25", "V25", "P25", "T25", "B26", "C26", "V26", "P26", "T26", "B28", "C28", "V28", "P28", "T28", "B29", "C29", "V29", "P29", "T29", "B30", "C30", "V30", "P30", "T30", "B31", "C31", "V31", "P31", "T31", "B32", "C32", "V32", "P32", "T32", "B33", "C33", "V33", "P33", "T33", "B34", "C34", "V34", "P34", "T34", "B36", "C36", "V36", "P36", "T36")
tSrc = Array("B37", "C37", "V37", "P37", "T37", "B38", "C38", "V38", "P38", "T38", "B39", "C39", "V39", "P39", "T39", "B40", "C40", "V40", "P40", "T40", "B41", "C41", "V41", "P41", "T41", "B42", "C42", "V42", "P42", "T42", "B44", "C44", "V44", "P44", "T44", "B45", "C45", "V45", "P45", "T45", "B46", "C46", "V46", "P46", "T46", "B47", "C47", "V47", "P47", "T47", "B48", "C48", "V48", "P48", "T48", "B49", "C49", "V49", "P49", "T49", "B50", "C50", "V50", "P50", "T50", "B52", "C52", "V52", "P52", "T52", "B53", "C53", "V53", "P53", "T53", "B54", "C54", "V54", "P54", "T54", "B55", "C55", "V55", "P55", "T55", "B56", "C56", "V56", "P56", "T56", "B57", "C57", "V57", "P57", "T57", "B58", "C58", "V58", "P58", "T58", "B60", "C60", "V60", "P60", "T60", "B61", "C61", "V61", "P61", "T61", "B62", "C62", "V62", "P62", "T62", "B63", "C63", "V63", "P63", "T63", "B64", "C64", "V64", "P64", "T64", "B65", "C65", "V65", "P65", "T65", "B66", "C66", "V66", "P66", "T66", "B68", "C68", "V68", "P68", "T68")
tSrc = Array("T69", "B69", "C69", "V69", "P69", "T69", "B70", "C70", "V70", "P70", "T70", "B71", "C71", "V71", "P71", "T71", "B72", "C72", "V72", "P72", "T72", "B73", "C73", "V73", "P73", "T73", "B74", "C74", "V74", "P74", "T74", "B76", "C76", "V76", "P76", "T76", "B77", "C77", "V77", "P77", "T77", "B78", "C78", "V78", "P78", "T78", "B79", "C79", "V79", "P79", "T79", "B80", "C80", "V80", "P80", "T80", "B81", "C81", "V81", "P81", "T81", "B82", "C82", "V82", "P82", "T82")

Sheets("Solde").Select
tDest = Array("B4", "C4", "D4", "E4", "F4", "B5", "C5", "D5", "E5", "F5", "B6", "C6", "D6", "E6", "F6", "B7", "C7", "D7", "E7", "F7", "B8", "C8", "D8", "E8", "F8", "B9", "C9", "D9", "E9", "F9", "B10", "C10", "D10", "E10", "F10", "B12", "C12", "D12", "E12", "F12", "B13", "C13", "D13", "E13", "F13", "B14", "C14", "D14", "E14", "F14", "B15", "C15", "D15", "E15", "F15", "B16", "C16", "D16", "E16", "F16", "B17", "C17", "D17", "E17", "F17", "B18", "C18", "D18", "E18", "F18", "B20", "C20", "D20", "E20", "F20", "B21", "C21", "D21", "E21", "F21", "B22", "C22", "D22", "E22", "F22", "B23", "C23", "D23", "E23", "F23", "B24", "C24", "D24", "E24", "F24", "B25", "C25", "D25", "E25", "F25", "B26", "C26", "D26", "E26", "F26", "B28", "C28", "D28", "E28", "F28", "B29", "C29", "D29", "E29", "F29", "B30", "C30", "D30", "E30", "F30", "B31", "C31", "D31", "E31", "F31", "B32", "C32", "D32", "E32", "F32", "B33", "C33", "D33", "E33", "F33", "B34", "C34", "D34", "E34", "F34", "B36", "C36", "D36", "E36", "F36")
tDest = Array("B37", "C37", "D37", "E37", "F37", "B38", "C38", "D38", "E38", "F38", "B39", "C39", "D39", "E39", "F39", "B40", "C40", "D40", "E40", "F40", "B41", "C41", "D41", "E41", "F41", "B42", "C42", "D42", "E42", "F42", "B44", "C44", "D44", "E44", "F44", "B45", "C45", "D45", "E45", "F45", "B46", "C46", "D46", "E46", "F46", "B47", "C47", "D47", "E47", "F47", "B48", "C48", "D48", "E48", "F48", "B49", "C49", "D49", "E49", "F49", "B50", "C50", "D50", "E50", "F50", "B52", "C52", "D52", "E52", "F52", "B53", "C53", "D53", "E53", "F53", "B54", "C54", "D54", "E54", "F54", "B55", "C55", "D55", "E55", "F55", "B56", "C56", "D56", "E56", "F56", "B57", "C57", "D57", "E57", "F57", "B58", "C58", "D58", "E58", "F58", "B60", "C60", "D60", "E60", "F60", "B61", "C61", "D61", "E61", "F61", "B62", "C62", "D62", "E62", "F62", "B63", "C63", "D63", "E63", "F63", "B64", "C64", "D64", "E64", "F64", "B65", "C65", "D65", "E65", "F65", "B66", "C66", "D66", "E66", "F66", "B68", "C68", "D68", "E68", "F68")
tDest = Array("B69", "C69", "D69", "E69", "F70", "B70", "C70", "D70", "E70", "F71", "B71", "C71", "D71", "E71", "F71", "B72", "C72", "D72", "E72", "F72", "B73", "C73", "D73", "E73", "F73", "B74", "C74", "D74", "E74", "F74", "B76", "C76", "D76", "E76", "F76", "B77", "C77", "D77", "E77", "F77", "B78", "C78", "D78", "E78", "F78", "B79", "C79", "D79", "E79", "F79", "B80", "C80", "D80", "E80", "F80", "B81", "C81", "D81", "E81", "F81", "B82", "C82", "D82", "E82", "F82")

Application.Calculation = xlCalculationManual
For i = LBound(tSrc) To UBound(tSrc)

    Sheets("Solde").Range(tDest(i)).Value = Worksheets(Sheets.Count).Range(tSrc(i)).Value
Next i

Application.Calculation = xlCalculationAutomatic
End Sub

Si tu vois ou je me trompe, cela m'aidera beaucoup.

A te relire.

Le 03/12/2021 à 12:52

Bonjour,

Pour le moment, la feuille Solde n'existe pas. Quand elle sera bien renommée (sans espace indésirable notamment et en respectant la casse), ça marchera.

En revanche, il faut affecter les array en une fois et pas 3 sinon ils ne garderont que les valeurs de leur dernière affectation.

Sub copieversTlicences1()
Dim tSrc, tDest, i&

tSrc = Array("B4", "C4", "V4", "P4", "T4", "B5", "C5", "V5", "P5", "T5", "B6", "C6", "V6", "P6", "T6", "B7", "C7", "V7", "P7", "T7", "B8", "C8", "V8", "P8", "T8", "B9", "C9", "V9", "P9", "T9", "B10", "C10", "V10", "P10", "T10", "B12", "C12", "V12", "P12", "T12", "B13", "C13", "V13", "P13", "T13", "B14", "C14", "V14", "P14", "T14", "B15", "C15", "V15", "P15", "T15", "B16", "C16", "V16", "P16", "T16", "B17", "C17", "V17", "P17", "T17", "B18", "C18", "V18", "P18", "T18", "B20", "C20", "V20", "P20", "T20", "B21", "C21", "V21", "P21", "T21", "B22", "C22", "V22", "P22", "T22", "B23", "C23", "V23", "P23", "T23", "B24", "C24", "V24", "P24", "T24", "B25", "C25", "V25", "P25", "T25", "B26", "C26", "V26", "P26", "T26", "B28", "C28", "V28", "P28", "T28", "B29", "C29", "V29", "P29", "T29", "B30", "C30", "V30", "P30", "T30", "B31", "C31", "V31", "P31", "T31", "B32", "C32", "V32", "P32", "T32", "B33", "C33", "V33", "P33", "T33", "B34", "C34", "V34", "P34", "T34", "B36", "C36", "V36", "P36", "T36", "B37", "C37", "V37", "P37", "T37", "B38", "C38", "V38", "P38", "T38", "B39", "C39", "V39", "P39", "T39", "B40", "C40", "V40", "P40", "T40", "B41", "C41", "V41", "P41", "T41", "B42", "C42", "V42", "P42", "T42", "B44", "C44", "V44", "P44", "T44", "B45", "C45", "V45", "P45", "T45", "B46", "C46", "V46", "P46", "T46", "B47", "C47", "V47", "P47", "T47", "B48", "C48", "V48", "P48", "T48", "B49", "C49", "V49", "P49", "T49", "B50", "C50", "V50", "P50", "T50", "B52", "C52", "V52", "P52", "T52", "B53", "C53", "V53", "P53", "T53", "B54", "C54", "V54", "P54", "T54", "B55", "C55", "V55", "P55", "T55", "B56", "C56", "V56", "P56", "T56", "B57", "C57", "V57", "P57", "T57", "B58", "C58", "V58", "P58", "T58", "B60", "C60", "V60", "P60", "T60", "B61", "C61", "V61", "P61", "T61", "B62", "C62", "V62", "P62", "T62", "B63", "C63", "V63", "P63", "T63", "B64", "C64", "V64", "P64", "T64", "B65", "C65", "V65", "P65", "T65", "B66", "C66", "V66", "P66", "T66", "B68", "C68", "V68", "P68", "T68", "T69", "B69", "C69", "V69", "P69", "T69", "B70", "C70", "V70", "P70", "T70", "B71", "C71", "V71", "P71", "T71", "B72", "C72", "V72", "P72", "T72", "B73", "C73", "V73", "P73", "T73", "B74", "C74", "V74", "P74", "T74", "B76", "C76", "V76", "P76", "T76", "B77", "C77", "V77", "P77", "T77", "B78", "C78", "V78", "P78", "T78", "B79", "C79", "V79", "P79", "T79", "B80", "C80", "V80", "P80", "T80", "B81", "C81", "V81", "P81", "T81", "B82", "C82", "V82", "P82", "T82")

tDest = Array("B4", "C4", "D4", "E4", "F4", "B5", "C5", "D5", "E5", "F5", "B6", "C6", "D6", "E6", "F6", "B7", "C7", "D7", "E7", "F7", "B8", "C8", "D8", "E8", "F8", "B9", "C9", "D9", "E9", "F9", "B10", "C10", "D10", "E10", "F10", "B12", "C12", "D12", "E12", "F12", "B13", "C13", "D13", "E13", "F13", "B14", "C14", "D14", "E14", "F14", "B15", "C15", "D15", "E15", "F15", "B16", "C16", "D16", "E16", "F16", "B17", "C17", "D17", "E17", "F17", "B18", "C18", "D18", "E18", "F18", "B20", "C20", "D20", "E20", "F20", "B21", "C21", "D21", "E21", "F21", "B22", "C22", "D22", "E22", "F22", "B23", "C23", "D23", "E23", "F23", "B24", "C24", "D24", "E24", "F24", "B25", "C25", "D25", "E25", "F25", "B26", "C26", "D26", "E26", "F26", "B28", "C28", "D28", "E28", "F28", "B29", "C29", "D29", "E29", "F29", "B30", "C30", "D30", "E30", "F30", "B31", "C31", "D31", "E31", "F31", "B32", "C32", "D32", "E32", "F32", "B33", "C33", "D33", "E33", "F33", "B34", "C34", "D34", "E34", "F34", "B36", "C36", "D36", "E36", "F36", "B37", "C37", "D37", "E37", "F37", "B38", "C38", "D38", "E38", "F38", "B39", "C39", "D39", "E39", "F39", "B40", "C40", "D40", "E40", "F40", "B41", "C41", "D41", "E41", "F41", "B42", "C42", "D42", "E42", "F42", "B44", "C44", "D44", "E44", "F44", "B45", "C45", "D45", "E45", "F45", "B46", "C46", "D46", "E46", "F46", "B47", "C47", "D47", "E47", "F47", "B48", "C48", "D48", "E48", "F48", "B49", "C49", "D49", "E49", "F49", "B50", "C50", "D50", "E50", "F50", "B52", "C52", "D52", "E52", "F52", "B53", "C53", "D53", "E53", "F53", "B54", "C54", "D54", "E54", "F54", "B55", "C55", "D55", "E55", "F55", "B56", "C56", "D56", "E56", "F56", "B57", "C57", "D57", "E57", "F57", "B58", "C58", "D58", "E58", "F58", "B60", "C60", "D60", "E60", "F60", "B61", "C61", "D61", "E61", "F61", "B62", "C62", "D62", "E62", "F62", "B63", "C63", "D63", "E63", "F63", "B64", "C64", "D64", "E64", "F64", "B65", "C65", "D65", "E65", "F65", "B66", "C66", "D66", "E66", "F66", "B68", "C68", "D68", "E68", "F68", "B69", "C69", "D69", "E69", "F70", "B70", "C70", "D70", "E70", "F71", "B71", "C71", "D71", "E71", "F71", "B72", "C72", "D72", "E72", "F72", "B73", "C73", "D73", "E73", "F73", "B74", "C74", "D74", "E74", "F74", "B76", "C76", "D76", "E76", "F76", "B77", "C77", "D77", "E77", "F77", "B78", "C78", "D78", "E78", "F78", "B79", "C79", "D79", "E79", "F79", "B80", "C80", "D80", "E80", "F80", "B81", "C81", "D81", "E81", "F81", "B82", "C82", "D82", "E82", "F82")

Application.Calculation = xlCalculationManual
For i = LBound(tSrc) To UBound(tSrc)
    Sheets("Solde").Range(tDest(i)).Value = Worksheets(Sheets.Count).Range(tSrc(i)).Value
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

Voici le code tel qu'il devrait être. Il faut juste que le nom de la feuille Solde soit identique à son nom sur l'onglet.

Il est nécessaire de trouver une alternative ici. Une première amélioration serait d'avoir 2 colonnes avec les adresses de la source et de la destination et d'affecter dynamiquement les arrays.

Cdlt,

Le 04/12/2021 à 19:08

Bonsoir 3GB.

Cela ne marche pas. J'ai changé le nom de la feuille solde.

Je joins le fichier pour voir ce qui ne fonctionne pas.

Merci d'avance.

A te relire.

2ventilation-des-adhesions-sport-et-loisirs-2021-2022-tr.zip (892.96 Ko)

Le 04/12/2021 à 19:16

Bonjour Ldopa,

Désolé, je n'ouvre pas les fichiers. Qu'est-ce qui ne marche pas ? Moi, je vois un code qui me semble fonctionnel à condition que :

- la feuille "Solde" existe et soit bien orthographiée,

- la dernière feuille soit différente de la feuille "Solde" justement.

Cdlt,

Le 04/12/2021 à 19:40

Merci de ta réponse rapide.

La feuille concerné s'appelle Solde, et est différente de la feuille qui fournie les donnée, qui se nomme 2020_2021.J'ai l'impression que l'erreur viens du fait que la chaine de caractère est trop longue ?

A te relire.

Le 04/12/2021 à 20:00

Aucune idée mais j'en doute quand même...

As-tu essayé avec un échantillon restreint de 5 adresses par exemple ?

De toute façon, comme dit précédemment, ce n'est pas concevable de laisser le code tel qu'il est. Il faut un tableau à 2 colonnes Source et Destination avec une correspondance sur chaque ligne : B4 en col1, B4 en col2, etc...

Alors j'adapterais le code...

Le 04/12/2021 à 20:32

J'ai fait comme tu m'a conseillé en ne gardant que les 35 premiers termes des deux ligne de la commande array.

et cela fonctionne. Ce que je n"arrive pas à faire c'est la continuité des ligne après le 35ème terme. je sais qu'ik faut utiliser un Under score (_), mais

cela ne fonctionne pas.

A te relire.

Le 04/12/2021 à 21:54

Après une virgule, il faut un espace, un underscore puis un retour à la ligne.

Mais peux-tu faire comme je t'ai conseillé avec un tableau structuré nommé "Adresses", contenant 2 colonnes, la première avec les adresses de la Source et la seconde la Destination :

SrcDest
B4B4
C4C4
V4D4
……

Puis ce code :

Sub copieversTlicences1()
Dim tRefs, i&
tRefs = range("Adresses").value 'doit etre un tableau structuré nommé Adresses (sinon, adapter le code)
Application.Calculation = xlCalculationManual
For i = LBound(tRefs) To UBound(tRefs)
    Sheets("Solde").Range(tRefs(i, 2)).Value = Worksheets(Sheets.Count).Range(tRefs(i, 1)).Value
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

Cdlt,

Le 05/12/2021 à 09:59

Bonjour 3GB.

Ok cela fonctionne, j'ai utilisé l'underscore, et corrigé quelques erreurs et oublis dans les lignes de code.

Je te remercie vraiment pour ton aide.

Je clos le post.

Au plaisir de te relire.

CDLT

Le 05/12/2021 à 10:40

Bonjour Ldopa,

Je t'en prie. Seulement, je te recommande vivement d'utiliser la dernière solution et le dernier code plutôt que celle avec l'underscore...

Bonne continuation,

Le 05/12/2021 à 10:46

Bonjour !

Arf, des dizaines et des dizaines de lignes, de rentrées manuelles, qui se résument à 10 lignes automatisées. Je suis déçu 😉

Le 05/12/2021 à 11:34

Bonjour Joyeux Noël.

Ta remarque m'intéresse.

CDLT

Le 05/12/2021 à 11:44

Bonjour,

Oh, il n'y a pas de quoi. C'était juste une façon de féliciter 3GB pour la résolution de cette affaire :)

Le 05/12/2021 à 13:03

Salut à tous,

je retire mon post , j'ai pas bien regardé le fichier source

Rechercher des sujets similaires à "simplifier procedure"