hello my Dear ... I Want Your Help To MODIFY This Code To Transfer All Data From Main Sheet To ANOTHER Sheets by the Name In Column P in Main Sheet ,in this Table ,,, So that if the stage data exceeds the number of tables, new tables are designed to accommodate the extra data .... Thank you very much
with Serial Function In Column A from Multiple Sheets
and this Acode
with Serial Function In Column A from Multiple Sheets
Code:
=IF($B8="","",SUBTOTAL(3,$B$8:B8))
Code:
Sub test()
Application.ScreenUpdating = False
ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp"
For Each sh In Worksheets
If sh.Name <> "Main" And sh.Name <> "Temp" Then
With Sheets("Main")
lr = .Cells(Rows.Count, 16).End(xlUp).Row + 1
.Range("$A$2:$AQ$" & lr).AutoFilter Field:=16, Criteria1:=sh.Name
Set rang = .Range("$A$2:$AQ$" & lr).SpecialCells(xlCellTypeVisible)
rang.Copy Sheets("TEmp").Range("A1")
.Cells.AutoFilter
With Sheets("Temp")
a = .Cells(1, 1).CurrentRegion
.Cells(1, 1).CurrentRegion.ClearContents
a = Application.Index(a, Evaluate("row(2:" & UBound(a) & ")"), Array(26, 30, "", 13))
End With
With sh
x = 1
For Each myArea In .Columns(1).SpecialCells(2, 1).Areas
n = myArea.Count
myArea.Offset(, 1).Resize(n, 4).Value = Application.IfError(Application.Index(a, Evaluate("row(" & x & ":" & _
x + n - 1 & ")"), Evaluate("column(" & [a1].Resize(, 4).Address & ")")), "")
x = x + n
Next
End With
End With
End If
Next
Sheets("Main").Select
Application.DisplayAlerts = flase
Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub