XL 2016 Copier des données en boucle d'un classeur à un autre

KTM

XLDnaute Impliqué
Bonjour chers tous
je suis entrain de construire une macro qui me permettra de copier les données de mon classeur actif vers un autre classeur selon le mois .
Pour boucler sur les 12 mois je me retrouve avec un long code.
Je voudrais solliciter votre expertise pour l'améliorer.
Merci
VB:
Sub Transferer()
    
    Dim chemin
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
     If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    
    With shFrom
    
    If Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 1 Then
      
      wkb.Worksheets(1).Range("G9:J23").Value = .[G6:J20].Value
      wkb.Worksheets(1).Range("L9:O23").Value = .[L6:O20].Value
      wkb.Worksheets(1).Range("Q9:T23").Value = .[Q6:T20].Value
      wkb.Worksheets(1).Range("V9:Y23").Value = .[V6:Y20].Value
      wkb.Worksheets(1).Range("AA9:AB23").Value = .[AA6:AB20].Value
      wkb.Worksheets(1).Range("AI9:AL23").Value = .[AI6:AL20].Value
      wkb.Worksheets(1).Range("AN9:AQ23").Value = .[AN6:AQ20].Value
      wkb.Worksheets(1).Range("AS9:AV23").Value = .[AS6:AV20].Value
      wkb.Worksheets(1).Range("AX9:BA23").Value = .[AX6:BA20].Value
      wkb.Worksheets(1).Range("BC9:BF23").Value = .[BC6:BF20].Value
      wkb.Worksheets(1).Range("BH9:BK23").Value = .[BH6:BK20].Value

      ElseIf Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 2 Then
      
      'un pas de 24 lignes vers le bas
      
      wkb.Worksheets(1).Range("G33:J47").Value = .[G6:J20].Value
      wkb.Worksheets(1).Range("L33:O47").Value = .[L6:O20].Value
      wkb.Worksheets(1).Range("Q33:T47").Value = .[Q6:T20].Value
      wkb.Worksheets(1).Range("V33:Y47").Value = .[V6:Y20].Value
      wkb.Worksheets(1).Range("AA33:AB47").Value = .[AA6:AB20].Value
      wkb.Worksheets(1).Range("AI33:AL47").Value = .[AI6:AL20].Value
      wkb.Worksheets(1).Range("AN33:AQ47").Value = .[AN6:AQ20].Value
      wkb.Worksheets(1).Range("AS33:AV47").Value = .[AS6:AV20].Value
      wkb.Worksheets(1).Range("AX33:BA47").Value = .[AX6:BA20].Value
      wkb.Worksheets(1).Range("BC33:BF47").Value = .[BC6:BF20].Value
      wkb.Worksheets(1).Range("BH33:BK47").Value = .[BH6:BK20].Value
      
      ElseIf Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 3 Then

      'un pas de 24 lignes vers le bas

      wkb.Worksheets(1).Range("G57:J71").Value = .[G6:J20].Value
      wkb.Worksheets(1).Range("L57:O71").Value = .[L6:O20].Value
      wkb.Worksheets(1).Range("Q57:T71").Value = .[Q6:T20].Value
      wkb.Worksheets(1).Range("V57:Y71").Value = .[V6:Y20].Value
      wkb.Worksheets(1).Range("AA57:AB71").Value = .[AA6:AB20].Value
      wkb.Worksheets(1).Range("AI57:AL71").Value = .[AI6:AL20].Value
      wkb.Worksheets(1).Range("AN57:AQ71").Value = .[AN6:AQ20].Value
      wkb.Worksheets(1).Range("AS57:AV71").Value = .[AS6:AV20].Value
      wkb.Worksheets(1).Range("AX57:BA71").Value = .[AX6:BA20].Value
      wkb.Worksheets(1).Range("BC57:BF71").Value = .[BC6:BF20].Value
      wkb.Worksheets(1).Range("BH57:BK71").Value = .[BH6:BK20].Value

      ElseIf Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 4 Then
          
        'un pas de 24 lignes vers le bas

      wkb.Worksheets(1).Range("G81:J95").Value = .[G6:J20].Value
      wkb.Worksheets(1).Range("L81:O95").Value = .[L6:O20].Value
      wkb.Worksheets(1).Range("Q81:T95").Value = .[Q6:T20].Value
      wkb.Worksheets(1).Range("V81:Y95").Value = .[V6:Y20].Value
      wkb.Worksheets(1).Range("AA81:AB95").Value = .[AA6:AB20].Value
      wkb.Worksheets(1).Range("AI81:AL95").Value = .[AI6:AL20].Value
      wkb.Worksheets(1).Range("AN81:AQ95").Value = .[AN6:AQ20].Value
      wkb.Worksheets(1).Range("AS81:AV95").Value = .[AS6:AV20].Value
      wkb.Worksheets(1).Range("AX81:BA95").Value = .[AX6:BA20].Value
      wkb.Worksheets(1).Range("BC81:BF95").Value = .[BC6:BF20].Value
      wkb.Worksheets(1).Range("BH81:BK95").Value = .[BH6:BK20].Value
      
      ElseIf Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 5 Then
          
          'Ainsi de suite jusqu"au 12ieme Mois
          
      ElseIf Month(ThisWorkbook.Worksheets("TB").Range("B11")) = 12 Then

          
     End If
     End With
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir KTM,
Un essai avec ceci :
VB:
Sub Transferer()
    Dim chemin
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
     If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    Set F = wkb.Worksheets(1)
    With shFrom
        ' Equation de Indice : Indice=24*[B11]-15
        Indice = 24 * Month(ThisWorkbook.Worksheets("TB").Range("B11")) - 15
        If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
        F.["G" & Indice & ":J" & " Indice+14"].Value = .[G6:J20].Value
        F.["L" & Indice & ":O" & " Indice+14"].Value = .[L6:O20].Value
        F.["Q" & Indice & ":T" & " Indice+14"].Value = .[Q6:T20].Value
        F.["V" & Indice & ":Y" & " Indice+14"].Value = .[V6:Y20].Value
        F.["AA" & Indice & ":AB" & " Indice+14"].Value = .[AA6:AB20].Value
        F.["AI" & Indice & ":AL" & " Indice+14"].Value = .[AI6:AL20].Value
        F.["AN" & Indice & ":AQ" & " Indice+14"].Value = .[AN6:AQ20].Value
        F.["AS" & Indice & ":AV" & " Indice+14"].Value = .[AS6:AV20].Value
        F.["AX" & Indice & ":BA" & " Indice+14"].Value = .[AX6:BA20].Value
        F.["BC" & Indice & ":BF" & " Indice+14"].Value = .[BC6:BF20].Value
        F.["BH" & Indice & ":BK" & " Indice+14"].Value = .[BH6:BK20].Value
    End With
End Sub
Mais sans fichier test, on code au pif, et donc le résultat risque du même acabit. :)
 

job75

XLDnaute Barbatruc
Bonsoir KTM, sylvanu,

Vous êtes sûr que cette ligne est correcte :
VB:
wkb.Worksheets(1).Range("AA9:AB23").Value = .[AA6:AB20].Value
Code:
car par rapport aux autres lignes il faudrait la colonne AD au lieu de la colonne AB.

Si cette ligne est bien correcte utilisez :
VB:
Sub Transferer()
    
    Dim chemin$, wkb As Workbook, shFrom As Worksheet, mois%, i%
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox chemin & " introuvable !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    mois = Month(ThisWorkbook.Worksheets("TB").Range("B11"))
    
    For i = 0 To 3
        wkb.Worksheets(1).Range("G9:J23").Offset(24 * (mois - 1), 5 * i) = shFrom.[G6:J20].Offset(24 * (mois - 1), 5 * i).Value
    Next
    
    wkb.Worksheets(1).Range("AA9:AB23").Offset(24 * (mois - 1)) = shFrom.[AA6:AB20].Offset(24 * (mois - 1)).Value 'j'espère que la colonne AB est correcte
    
    For i = 0 To 5
        wkb.Worksheets(1).Range("AI9:AL23").Offset(24 * (mois - 1), 5 * i) = shFrom.[AI:AL20].Offset(24 * (mois - 1), 5 * i).Value
    Next

End Sub
A+
 

KTM

XLDnaute Impliqué
Bonsoir KTM, sylvanu,

Vous êtes sûr que cette ligne est correcte :
VB:
wkb.Worksheets(1).Range("AA9:AB23").Value = .[AA6:AB20].Value
Code:
car par rapport aux autres lignes il faudrait la colonne AD au lieu de la colonne AB.

Si cette ligne est bien correcte utilisez :
VB:
Sub Transferer()
   
    Dim chemin$, wkb As Workbook, shFrom As Worksheet, mois%, i%
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox chemin & " introuvable !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
   
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    mois = Month(ThisWorkbook.Worksheets("TB").Range("B11"))
   
    For i = 0 To 3
        wkb.Worksheets(1).Range("G9:J23").Offset(24 * (mois - 1), 5 * i) = shFrom.[G6:J20].Offset(24 * (mois - 1), 5 * i).Value
    Next
   
    wkb.Worksheets(1).Range("AA9:AB23").Offset(24 * (mois - 1)) = shFrom.[AA6:AB20].Offset(24 * (mois - 1)).Value 'j'espère que la colonne AB est correcte
   
    For i = 0 To 5
        wkb.Worksheets(1).Range("AI9:AL23").Offset(24 * (mois - 1), 5 * i) = shFrom.[AI:AL20].Offset(24 * (mois - 1), 5 * i).Value
    Next

End Sub
A+
Merci
La colonne AB est correcte
Je teste et je vous reviens
Merci infiniment.
 

KTM

XLDnaute Impliqué
Bonsoir KTM,
Un essai avec ceci :
VB:
Sub Transferer()
    Dim chemin
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
     If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    Set F = wkb.Worksheets(1)
    With shFrom
        ' Equation de Indice : Indice=24*[B11]-15
        Indice = 24 * Month(ThisWorkbook.Worksheets("TB").Range("B11")) - 15
        If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
        F.["G" & Indice & ":J" & " Indice+14"].Value = .[G6:J20].Value
        F.["L" & Indice & ":O" & " Indice+14"].Value = .[L6:O20].Value
        F.["Q" & Indice & ":T" & " Indice+14"].Value = .[Q6:T20].Value
        F.["V" & Indice & ":Y" & " Indice+14"].Value = .[V6:Y20].Value
        F.["AA" & Indice & ":AB" & " Indice+14"].Value = .[AA6:AB20].Value
        F.["AI" & Indice & ":AL" & " Indice+14"].Value = .[AI6:AL20].Value
        F.["AN" & Indice & ":AQ" & " Indice+14"].Value = .[AN6:AQ20].Value
        F.["AS" & Indice & ":AV" & " Indice+14"].Value = .[AS6:AV20].Value
        F.["AX" & Indice & ":BA" & " Indice+14"].Value = .[AX6:BA20].Value
        F.["BC" & Indice & ":BF" & " Indice+14"].Value = .[BC6:BF20].Value
        F.["BH" & Indice & ":BK" & " Indice+14"].Value = .[BH6:BK20].Value
    End With
End Sub
Mais sans fichier test, on code au pif, et donc le résultat risque du même acabit. :)
Merci énormément
Je teste et je vous reviens.
 

KTM

XLDnaute Impliqué
Bonsoir KTM,
Un essai avec ceci :
VB:
Sub Transferer()
    Dim chemin
    Dim wkb As Workbook
    Dim shFrom As Worksheet
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
     If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    Set F = wkb.Worksheets(1)
    With shFrom
        ' Equation de Indice : Indice=24*[B11]-15
        Indice = 24 * Month(ThisWorkbook.Worksheets("TB").Range("B11")) - 15
        If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
        F.["G" & Indice & ":J" & " Indice+14"].Value = .[G6:J20].Value
        F.["L" & Indice & ":O" & " Indice+14"].Value = .[L6:O20].Value
        F.["Q" & Indice & ":T" & " Indice+14"].Value = .[Q6:T20].Value
        F.["V" & Indice & ":Y" & " Indice+14"].Value = .[V6:Y20].Value
        F.["AA" & Indice & ":AB" & " Indice+14"].Value = .[AA6:AB20].Value
        F.["AI" & Indice & ":AL" & " Indice+14"].Value = .[AI6:AL20].Value
        F.["AN" & Indice & ":AQ" & " Indice+14"].Value = .[AN6:AQ20].Value
        F.["AS" & Indice & ":AV" & " Indice+14"].Value = .[AS6:AV20].Value
        F.["AX" & Indice & ":BA" & " Indice+14"].Value = .[AX6:BA20].Value
        F.["BC" & Indice & ":BF" & " Indice+14"].Value = .[BC6:BF20].Value
        F.["BH" & Indice & ":BK" & " Indice+14"].Value = .[BH6:BK20].Value
    End With
End Sub
Mais sans fichier test, on code au pif, et donc le résultat risque du même acabit. :)
Testé d'entrée , ça n'a pas marché ; des erreurs m'ont été signalées.
j'ai donc vérifié votre code et apporté de toutes petites modifications et tout est rentré dans l'ordre .
Encore Merci.

Comme ceci
VB:
Sub Transferer()
    Dim chemin, Indice As Integer
    Dim wkb As Workbook
    Dim shFrom
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
     If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    With shFrom
        ' Equation de Indice : Indice=24*[B11]-15
        Indice = 24 * Month(ThisWorkbook.Worksheets("TB").Range("B11")) - 15
        If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
        wkb.Worksheets(1).Range("G" & Indice & ":J" & Indice + 14).Value = .[G6:J20].Value
        wkb.Worksheets(1).Range("L" & Indice & ":O" & Indice + 14).Value = .[L6:O20].Value
        wkb.Worksheets(1).Range("Q" & Indice & ":T" & Indice + 14).Value = .[Q6:T20].Value
        wkb.Worksheets(1).Range("V" & Indice & ":Y" & Indice + 14).Value = .[V6:Y20].Value
        wkb.Worksheets(1).Range("AA" & Indice & ":AB" & Indice + 14).Value = .[AA6:AB20].Value
        wkb.Worksheets(1).Range("AI" & Indice & ":AL" & Indice + 14).Value = .[AI6:AL20].Value
        wkb.Worksheets(1).Range("AN" & Indice & ":AQ" & Indice + 14).Value = .[AN6:AQ20].Value
        wkb.Worksheets(1).Range("AS" & Indice & ":AV" & Indice + 14).Value = .[AS6:AV20].Value
        wkb.Worksheets(1).Range("AX" & Indice & ":BA" & Indice + 14).Value = .[AX6:BA20].Value
        wkb.Worksheets(1).Range("BC" & Indice & ":BF" & Indice + 14).Value = .[BC6:BF20].Value
        wkb.Worksheets(1).Range("BH" & Indice & ":BK" & Indice + 14).Value = .[BH6:BK20].Value
    End With
End Sub
 

KTM

XLDnaute Impliqué
Bonsoir KTM, sylvanu,

Vous êtes sûr que cette ligne est correcte :
VB:
wkb.Worksheets(1).Range("AA9:AB23").Value = .[AA6:AB20].Value
Code:
car par rapport aux autres lignes il faudrait la colonne AD au lieu de la colonne AB.

Si cette ligne est bien correcte utilisez :
VB:
Sub Transferer()
   
    Dim chemin$, wkb As Workbook, shFrom As Worksheet, mois%, i%
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox chemin & " introuvable !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
   
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    mois = Month(ThisWorkbook.Worksheets("TB").Range("B11"))
   
    For i = 0 To 3
        wkb.Worksheets(1).Range("G9:J23").Offset(24 * (mois - 1), 5 * i) = shFrom.[G6:J20].Offset(24 * (mois - 1), 5 * i).Value
    Next
   
    wkb.Worksheets(1).Range("AA9:AB23").Offset(24 * (mois - 1)) = shFrom.[AA6:AB20].Offset(24 * (mois - 1)).Value 'j'espère que la colonne AB est correcte
   
    For i = 0 To 5
        wkb.Worksheets(1).Range("AI9:AL23").Offset(24 * (mois - 1), 5 * i) = shFrom.[AI:AL20].Offset(24 * (mois - 1), 5 * i).Value
    Next

End Sub
A+
Merci Job75
Testé mais il se produit rien . Peut être quelques détails à revoir !
Par contre le code de Sylvanu fonctionne après quelques petits réglages.
 

job75

XLDnaute Barbatruc
Ma macro corrigée :
VB:
Sub Transferer()
    
    Dim chemin$, wkb As Workbook, shFrom As Worksheet, mois%, i%
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox chemin & " introuvable !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
    
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    mois = Month(ThisWorkbook.Worksheets("TB").Range("B11"))
    
    For i = 0 To 3
        wkb.Worksheets(1).Range("G9:J23").Offset(24 * (mois - 1), 5 * i) = shFrom.[G6:J20].Offset(, 5 * i).Value
    Next
    
    wkb.Worksheets(1).Range("AA9:AB23").Offset(24 * (mois - 1)) = shFrom.[AA6:AB20].Value
    
    For i = 0 To 5
        wkb.Worksheets(1).Range("AI9:AL23").Offset(24 * (mois - 1), 5 * i) = shFrom.[AI:AL20].Offset(, 5 * i).Value
    Next

End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour KTM, Job,
Ou encore, juste pour le fun, issu du code rectifié du post #6 en utilisant deux arrays :
VB:
Sub Transferer()
    Dim chemin, Id%, i%, wkb As Workbook, wkb1, shFrom, A(), B()
    A = Array("G", "L", "Q", "V", "AA", "AI", "AN", "AS", "AX", "BC", "BH")
    B = Array("J", "O", "T", "Y", "AB", "AL", "AQ", "AV", "BA", "BF", "BK")
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin): Set wkb1 = wkb.Worksheets(1)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    ' Equation de l'indice : Id=24*[B11]-15
    Indice = 24 * Month(ThisWorkbook.Worksheets("TB").[B11]) - 15
    If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
    For i = 0 To UBound(A)
        wkb1.Range(A(i) & Id & ":" & B(i) & Id + 14).Value = shFrom.Range(A(i) & "6:" & B(i) & "20").Value
    Next i
End Sub
 

KTM

XLDnaute Impliqué
Bonjour KTM, Job,
Ou encore, juste pour le fun, issu du code rectifié du post #6 en utilisant deux arrays :
VB:
Sub Transferer()
    Dim chemin, Id%, i%, wkb As Workbook, wkb1, shFrom, A(), B()
    A = Array("G", "L", "Q", "V", "AA", "AI", "AN", "AS", "AX", "BC", "BH")
    B = Array("J", "O", "T", "Y", "AB", "AL", "AQ", "AV", "BA", "BF", "BK")
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox "Canevas.xlsx n'existe pas !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin): Set wkb1 = wkb.Worksheets(1)
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    ' Equation de l'indice : Id=24*[B11]-15
    Indice = 24 * Month(ThisWorkbook.Worksheets("TB").[B11]) - 15
    If Indice > 273 Then Exit Sub    ' si hors limite ( car 14*12-15=273 )
    For i = 0 To UBound(A)
        wkb1.Range(A(i) & Id & ":" & B(i) & Id + 14).Value = shFrom.Range(A(i) & "6:" & B(i) & "20").Value
    Next i
End Sub
La macro semble impeccable
Mais je voudrais comprendre la ligne : ' Equation de l'indice : Id=24*[B11]-15
Merci...
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour KTM,
Dans votre post #1 vous faites référence à des blocs qui commencent en ligne 9, 33, 57, 81 ...
Si on utilise des N° de blocs de 1 à 12 alors le N° de bloc X commence en ligne
24*N°Bloc-15.
Il vous suffit de tracer la courbe avec en X 1,2,3,4 et en Y 9,33,57,81, d'en faire la droite de tendance et XL vous donne :
1637760894059.png

:)
 

KTM

XLDnaute Impliqué
Bonjour KTM,
Dans votre post #1 vous faites référence à des blocs qui commencent en ligne 9, 33, 57, 81 ...
Si on utilise des N° de blocs de 1 à 12 alors le N° de bloc X commence en ligne
24*N°Bloc-15.
Il vous suffit de tracer la courbe avec en X 1,2,3,4 et en Y 9,33,57,81, d'en faire la droite de tendance et XL vous donne : Regarde la pièce jointe 1122686
:)
OK Merci
J'ai donc remplacé dans la boucle de votre code : Id par Indice .
C' est super!
 

KTM

XLDnaute Impliqué
Ma macro corrigée :
VB:
Sub Transferer()
   
    Dim chemin$, wkb As Workbook, shFrom As Worksheet, mois%, i%
    chemin = ThisWorkbook.Path & "\Canevas.xlsx"
    If Dir(chemin) = "" Then MsgBox chemin & " introuvable !", 48: Exit Sub
    Set wkb = Workbooks.Open(chemin)
   
    Set shFrom = ThisWorkbook.Worksheets("A_Transferer")
    mois = Month(ThisWorkbook.Worksheets("TB").Range("B11"))
   
    For i = 0 To 3
        wkb.Worksheets(1).Range("G9:J23").Offset(24 * (mois - 1), 5 * i) = shFrom.[G6:J20].Offset(, 5 * i).Value
    Next
   
    wkb.Worksheets(1).Range("AA9:AB23").Offset(24 * (mois - 1)) = shFrom.[AA6:AB20].Value
   
    For i = 0 To 5
        wkb.Worksheets(1).Range("AI9:AL23").Offset(24 * (mois - 1), 5 * i) = shFrom.[AI:AL20].Offset(, 5 * i).Value
    Next

End Sub
Merci Job75
J'ai testé ce code et c'est formidablement merveilleux!!!!
 

Statistiques des forums

Discussions
292 811
Messages
1 926 469
Membres
183 093
dernier inscrit
Juvenat