I'm sorry, I didn't get that. May you show me where I put those lines, please?
I'm sorry, I didn't get that. May you show me where I put those lines, please?
[vba]Private Sub Worksheet_Activate()
Dim WS_Count As Integer
Dim I AsInteger
Dim rowcounterA() As Integer
Dim rowcounterD() As Integer
Application.EnableEvents = False
With Worksheets("Menu")
Lastrowa = .Cells(Cells.Rows.Count, "AF").End(xlUp).Row
lastrowD = .Cells(Cells.Rows.Count, "AJ").End(xlUp).Row
If Lastrowa > lastrowD Then
inarr = .Range(.Cells(1, 1), .Cells(Lastrowa, 36))
Else
inarr = .Range(.Cells(1, 1), .Cells(lastrowD, 36))
End If
End With
WS_Count = ActiveWorkbook.Worksheets.Count
ReDim rowcounterA(1 To WS_Count)
ReDim rowcounterD(1 To WS_Count)
For I = 1 To WS_Count
rowcounterA(I) = 0
rowcounterD(I) = 0
With Worksheets(I)
If Not (.Name = "Menu") Then
For j = 3 To Lastrowa
If inarr(j, 32) = .Cells(1, 2) Then
.Cells(216 + rowcounterA(I), 11) = inarr(j, 35)
rowcounterA(I) = rowcounterA(I) + 1
End If
Next j
For j = 3 To lastrowD
If inarr(j, 36) = .Cells(1, 2) Then
.Cells(216 + rowcounterD(I), 12) = inarr(j, 35)
rowcounterD(I) = rowcounterD(I) + 1
End If
Next j
End If
End With
Next I
Application.EnableEvents = True
EndSub
[/vba]