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

  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début
KTM

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
 
Trier par date Trier par votes
sylvanu

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. :)
 
Vote positif 0 Vote négatif
job75

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+
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
job75 à dit:
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+
Cliquez pour agrandir...
Merci
La colonne AB est correcte
Je teste et je vous reviens
Merci infiniment.
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
sylvanu à dit:
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. :)
Cliquez pour agrandir...
Merci énormément
Je teste et je vous reviens.
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
sylvanu à dit:
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. :)
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
job75 à dit:
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+
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

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
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
sylvanu à dit:
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
Cliquez pour agrandir...
La macro semble impeccable
Mais je voudrais comprendre la ligne : ' Equation de l'indice : Id=24*[B11]-15
Merci...
 
Vote positif 0 Vote négatif
sylvanu

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

:)
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
sylvanu à dit:
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
:)
Cliquez pour agrandir...
OK Merci
J'ai donc remplacé dans la boucle de votre code : Id par Indice .
C' est super!
 
Vote positif 0 Vote négatif
KTM

KTM

XLDnaute Impliqué
job75 à dit:
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
Cliquez pour agrandir...
Merci Job75
J'ai testé ce code et c'est formidablement merveilleux!!!!
 
Vote positif 0 Vote négatif

Discussions similaires

medlight
  • Question Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
558
Oneida
Oneida
R
  • Question Question
Microsoft 365 Copier des données d'un fichier à un autre en vérifiant si elles existent déjà
Réponses
1
Affichages
617
yal
Y
XLSM75
  • Question Question
XL 2019 Extraire données d'un classeur vers un autre en réorganisant et renommant les colonnes
Réponses
10
Affichages
2 K
XLSM75
XLSM75
L
  • Résolu(e)
XL 2019 Copier/Coller valeur + couleur d'un classeur à un autre
Réponses
7
Affichages
2 K
Etoto
Etoto
S
  • Résolu(e)
Microsoft 365 automatiser macro pour copier/coller des données d´un classeur à un autre et sauver à chaque fois le classeur rempli
Réponses
8
Affichages
4 K
sevenkingdom
S
B
  • Question Question
XL 2016 Importer des données d'un autre classeur en VBA
Réponses
2
Affichages
8 K
Bourbonkid59
B
C
  • Question Question
Copier/Coller des colonnes séparées d'un classeur à un autre
Réponses
2
Affichages
918
cecidk
C
D
  • Question Question
VBA EXCEL : tri de données sur colonnes multiples.
Réponses
3
Affichages
1 K
dirkv
D
S
  • Question Question
Copier des données d'une feuille à un nouveau classeur Excel
Réponses
2
Affichages
1 K
sinced
S
Z
  • Question Question
Copier des données d'un fichier vers un autre situé dans un serveur dossier
Réponses
0
Affichages
740
zombe
Z
D
  • Question Question
Sur un même classeur, copier coller des données d'une feuille sur une autre (format)
Réponses
6
Affichages
1 K
Efgé
Efgé
P
  • Question Question
Copier coller des données d'un classeur fermer à un autre à l'ouverture du dernier
Réponses
2
Affichages
1 K
poups
P
J
  • Question Question
Envoyer des données d'un classeur à un autre en fo
Réponses
0
Affichages
1 K
joul13
J

Membres actuellement en ligne

14 membres et 203 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 283
Messages
2 118 017
Membres
113 410
dernier inscrit
ffgsd