Sub COLLE

[JANO]

Bonjour à tous,

comment faire pour que mon code ci-dessous, sélection le 1er onglet, puis va coller dans "total" et ensuite faire la même chose avec tous les onglets.

parce là il sélection toute les feuilles mais ne colle que la dernière

Sub colle()

Application.ScreenUpdating = False

Sheets("Total").Select
Columns("A:A").Select
Range("A65536").End(xlUp).Offset(1, 0).Select



Dim i As Byte
For i = 1 To Sheets.Count - 1
Sheets(i).Select IIf(i = 1, 1, 0)
Next i


Range("a2:f2").Select
Selection.Copy
Sheets("Total").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Offset(0, 1).Select


Range("A1").Select

Application.CutCopyMode = False



End Sub


ci joint le fichier !


Merci de votre aide

 

[Staple1600]

Re : Sub COLLE

Bonsoir

Une solution possible

Sub colle2()
Dim s As Worksheet
    For Each s In Worksheets
        If Not s.Name Like "Total" Then
            With s.[A1].CurrentRegion
            Sheets("Total").[A65536].End(xlUp)(2).Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Value
            End With
        End If
    Next
End Sub

 

[JANO]

Re : Sub COLLE

Merci, cela fonctionne très bien.
Bonne soirée 🙂