Bonjour,
J'ai un fichier avec 6 onglets, je souhaiterais regrouper ces 6 feuilles sur une 7ème feuillle "Total", en compilant les données de toutes les feuilles les unes en dessous des autres (sachant que les titres des colonnes (A-Y) sont les mêmes sur toutes les feuilles, et les données à récupérer ne commencent qu'à partir de la ligne 3!) J'ai créé un code VBA, malheureusement il ne me compile que 3 lignes de chaque feuille, et pas toutes les lignes non vides... Pourriez-vous m'aider? Merci!
Voici le code:
Sub TransfertOpérations()
Dim MyRange As Range
Dim i As Integer, j As Byte
Dim C As Variant
Dim S As String
Application.ScreenUpdating = False
Sheets("TOTAL-CHAUDRON").Range("A1:Y3000").ClearContents
Set MyRange = Range(Sheets("BARBIER-A.").[A3], Sheets("BARBIER-A.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("BARBIER-S.").[A3], Sheets("BARBIER-S.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("CAMPHIN").[A3], Sheets("CAMPHIN").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("FAUVEAUX").[A3], Sheets("FAUVEAUX").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("GURGUL").[A3], Sheets("GURGUL").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("STELMASZYK").[A3], Sheets("STELMASZYK").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
End Sub
J'ai un fichier avec 6 onglets, je souhaiterais regrouper ces 6 feuilles sur une 7ème feuillle "Total", en compilant les données de toutes les feuilles les unes en dessous des autres (sachant que les titres des colonnes (A-Y) sont les mêmes sur toutes les feuilles, et les données à récupérer ne commencent qu'à partir de la ligne 3!) J'ai créé un code VBA, malheureusement il ne me compile que 3 lignes de chaque feuille, et pas toutes les lignes non vides... Pourriez-vous m'aider? Merci!
Voici le code:
Sub TransfertOpérations()
Dim MyRange As Range
Dim i As Integer, j As Byte
Dim C As Variant
Dim S As String
Application.ScreenUpdating = False
Sheets("TOTAL-CHAUDRON").Range("A1:Y3000").ClearContents
Set MyRange = Range(Sheets("BARBIER-A.").[A3], Sheets("BARBIER-A.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("BARBIER-S.").[A3], Sheets("BARBIER-S.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("CAMPHIN").[A3], Sheets("CAMPHIN").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("FAUVEAUX").[A3], Sheets("FAUVEAUX").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("GURGUL").[A3], Sheets("GURGUL").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
Set MyRange = Range(Sheets("STELMASZYK").[A3], Sheets("STELMASZYK").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
End Sub