• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Modify Transfer Code From One Sheet to Multiple Sheets

Hany ali

Active Member
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
Code:
=IF($B8="","",SUBTOTAL(3,$B$8:B8))
and this Acode
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
 

Attachments

p45cal

Well-Known Member
Complicated.
Is this chiefly for printing out?
If so it might be easier to use some built-in functionality.
Have a look at the print preview (File|Print|Show Print Preview), (not the page break preview) of the attached and indicate to me if it's a path you might want to explore further…
 

Attachments

Hany ali

Active Member
Thank you very much - Printing in this way is excellent and is really part of what is required
But the main requirement is to Moving & Copy Data for each page and paste it into tables from one page to the rest of the file pages, provided the name in the column P From Main Sheet ,and if Moving Data From Main Sheet is More Than Tables if Possible to make New Tables to Enough For all Data By The Same Formatting
 

p45cal

Well-Known Member
Click the red button at cell AS1 of the attached. Then File|Print|Show Print Preview.
Look at the code in macro test2:
First line allows you to choose how many rows of data per page - trial and error.
Agent sheets are deleted and recreated as necessary. Agents' sheets not present in the Main sheet are not deleted.
 

Attachments

Hany ali

Active Member
All thanks to your high taste ... You are truly a creative professor, and I do not covet more than that ... Really excellent, elaborate and more than required work.
 
Top