Sub COLLE

JANO · 13 Février 2010

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 · 13 Février 2010

Re : Sub COLLE

Bonsoir

Une solution possible

Code:

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 · 13 Février 2010

Re : Sub COLLE

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

Sub COLLE

JANO

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

JANO

XLDnaute Occasionnel

Discussions similaires

Sub COLLE

JANO

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

JANO

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency