1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
| Sub RECAP()
Dim ShDest As Worksheet, Sh As Worksheet
Dim DerLig As Long, DerCol As Integer
Dim Adr As String
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Recap").Delete
Application.DisplayAlerts = True
Set ShDest = Worksheets.Add
ShDest.Name = "Recap"
For Each Sh In Worksheets
If LCase(Sh.Name) <> LCase("recap") Then
a = a + 1
With Sh
With .Cells
DerLig = .Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End With
If a = 1 Then
.Range("A1", Cells(DerLig, DerCol)).Copy _
ShDest.Range("A1")
Else
Adr = ShDest.Range("A" _
& ShDest.Range("A65536").End(xlUp)(2).Row).Address
.Range("A1", .Cells(DerLig, DerCol)).Copy _
ShDest.Range(Adr)
End Sub |
Partager