CODEWITHSUNDEEP
vbaexcel
Yigit Tanverdi
Yigit Tanverdi

Reputation: 161

lomerging copy pasted worksheets into one

i am trying to merge different amount of worksheets into one. This code opens any amount of file in my directory and copy/pastes each sheets called "data" in to "makrotochange.xlsm" which is my masterworkbook.

 Sub LoopThroughFiles()
   Dim StrFile As String
   Dim WB As Workbook
   Dim InputFilePath As String
InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\"
StrFile = Dir(InputFilePath & "*")

Do While Len(StrFile) > 0
    Set WB = Workbooks.Open(InputFilePath & StrFile)
    WB.Activate
        Sheets("data").Select
        Sheets("data").Move After:=Workbooks("makrotochange.xlsm").Sheets(23)
        StrFile = Dir()
Loop
End Sub

Each data worksheet has columns starting from A to ZZ with different amount of rows and i want to merge these copied/pasted datasheets into a one worksheet inside my masterworkbook "makrotochange.xlsm".

How can i merge these worksheets into one?

Upvotes: 0

Views: 44

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

Something like this:

Sub LoopThroughFiles()

    Dim StrFile As String
    Dim WB As Workbook, rng As Range
    Dim InputFilePath As String

    InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\" & _
            "055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\"

    StrFile = Dir(InputFilePath & "*")

    Do While Len(StrFile) > 0

        Set WB = Workbooks.Open(InputFilePath & StrFile)

        'follwoing assumes your data is tabular with no empty rows/columns
        Set rng = WB.Sheets("data").Range("A1").CurrentRegion

        'exclude the header row
        Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count).Offset(1, 0)

        'copy to the macro workbook at next empty row
        'NOTE: ColA must always contain a value
        '      Also assuming there's enough room for the paste...
        rng.Copy ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Loop
End Sub

Upvotes: 0

Related Questions