Sub Group()
Dim plg As Range
Dim l As Long
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "SUMMARY" Then
With Ws
Set plg = Ws.Range("A2:B" & Ws.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
l = plg.Rows.Count
plg.Copy
With Sheets("SUMMARY").Range("A65536")
With .End(xlUp)
.Offset(1, 0).PasteSpecial xlValues
.Offset(1, 2).Resize(l, 1).Value = Ws.Name
End With
End With
Application.CutCopyMode = False
End With
End If
Next
'Call TRI
End Sub
Essaie ces modifications (Un problème persiste)
Option Explicit
Sub test()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "SUMMARY" Then
Ws.Range("[COLOR="Red"][B]A4[/B][/COLOR]:B" & Ws.Range("A65536").End(xlUp).Row).Copy _
Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(0, 2).Value = Ws.Name
End If
Next
End Sub
Option Explicit
Sub test()
Dim Ws As Worksheet
For Each Ws In Worksheets
If Ws.Name <> "SUMMARY" Then
Ws.Range("A4:B" & Ws.Range("A65536").End(xlUp).Row).Copy _
Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(1, 0)
With Sheets("SUMMARY")
.Range(.Range("C65536").End(xlUp).Offset(1, 0), .Range("C" & .Range("A65536").End(xlUp).Row)).Value = Ws.Name
End With
End If
Next
End Sub