[RESOLVED] Append 2 or more workbooks of multiple sheets into a single workbook

Hi everybody,
I have 6 excel workbooks each with 193 sheets. Format of all the workbooks is same with the same sheet names. I want to append the data of all the 6 workbooks into one workbook just like sheet1 of workbook1 would have the original data of sheet1 of workbook1 then in the very next empty available row paste the data of sheet1 of workbook2 then sheet1 of workbook3 and so on till sheet1 of workbook6, same for the sheet2 , sheet3....................sheet193.

I wrote this code it is working but it does not paste by maintaining the sequence (Problem is it sometimes paste the sheet3 of workbook2 into the sheet1 of workbook1 but by desire it should paste the sheet1 of workbook2 into the sheet1 of workbook1)

All six Workbook names are:
HYD15.xls
HYD16.xls
HYD17.xls
HYD18.xls
HYD19.xls
HYD20.xls


I am appending HYD16.xls and HYD17.xls into HYD15.xls (kindly help)

Code:

---

Sub append_test()
   
    For Index = 1 To 193
   
    Windows("HYD16.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    lastCol = ActiveSheet.Range("a6").End(xlToRight).Column
    lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
    ActiveSheet.Range("a6:" & _
    ActiveSheet.Cells(lastRow, lastCol).Address).Select
    Selection.Copy
    Windows("HYD15.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    NextRow = Range("A65536").End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Worksheets(ActiveSheet.Index + 1).Activate
   
    Next Index
    For Index = 1 To 193
   
    Windows("HYD16.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    lastCol = ActiveSheet.Range("a6").End(xlToRight).Column
    lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
    ActiveSheet.Range("a6:" & _
    ActiveSheet.Cells(lastRow, lastCol).Address).Select
    Selection.Copy
    Windows("HYD15.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    NextRow = Range("A65536").End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Worksheets(ActiveSheet.Index + 1).Activate
   
    Next Index

End Sub

---

3 threads for the same question?

yeah because its very very very urgent.

Starting several threads will not help. Never start more than 1 thread per question.

Why on earth would anyone have 193 sheets in an Excel workbook!

To locate your problem, set a breakpoint and step through your code to see what is going wrong.

I will thank you to watch both your language and your attitude.

Verbal abuse will not be tolerated.

I have deleted the duplicate threads you created as well as the duplicate post in this thread.

Do not create duplicates for the same question and do not bump your own threads. Your questions will be addressed as the individuals (all volunteers) have the time to do so.

Quote:

---

I wrote this code it is working but it does not paste by maintaining the sequence (Problem is it sometimes paste the sheet3 of workbook2 into the sheet1 of workbook1 but by desire it should paste the sheet1 of workbook2 into the sheet1 of workbook1)

---

most probably this is because you are working with active sheet and other none specific objects, you should fully qualify each sheet object to prevent this type of error

Quote:

---

yeah because its very very very urgent.

---

i ignored this thread last night as i saw 3 copies of same

vbakillsnuts

Welcome to the forums :wave:

The simplest way to do this would be to declare your objects Ex: Workbooks, Worksheets etc. This would help you easily work with them. Also avoid

Code:

---

.Select

---

and .

Code:

---

.Activate

---

as they are a major cause of errors besides making your macro very slow.

This is what I propose.

Create a New workbook and then insert a module there. Paste this code. This code will insert 193 sheets in the current workbook and merge data from all the sheets from all 6 workbooks. Please note that I have not tested it so do let us know if you get stuck :)

I have also commented the code so you will not have any problem understanding it. The current code is designed to work with only 2 workbooks but I have left instructions on how to add the code for the other 4. Remember to change the code to suit your needs before you test it.

Code:

---

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook, wb6 As Workbook
    Dim ws As Worksheet
    Dim i As Long, wsLRow As Long
   
    '~~> Change path as applicable
    Set wb1 = Workbooks.Open("C:\HYD15.xls")
    Set wb2 = Workbooks.Open("C:\HYD16.xls")
    Set wb3 = Workbooks.Open("C:\HYD17.xls")
    Set wb4 = Workbooks.Open("C:\HYD18.xls")
    Set wb5 = Workbooks.Open("C:\HYD19.xls")
    Set wb6 = Workbooks.Open("C:\HYD20.xls")
   
    '~~> This will copy all 193 sheets into the current workbook from HYD15
    wsLRow = 1
    For i = 1 To 193
        Set ws = ThisWorkbook.Sheets.Add
        ws.Name = wb1.Sheets(i).Name
        CopyFrom wb1.Sheets(i), ws, wsLRow
    Next
   
    '~~> This will copy all 193 sheets into the current workbook from HYD16
    For i = 1 To 193
        '~~> no Need to add new sheet. use the already created sheets
        Set ws = ThisWorkbook.Sheets(wb2.Sheets(i).Name)
       
        '~~> Find the next empty row
        wsLRow = ws.Cells.Find(What:="*", _
                          After:=ws.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row + 1
       
        CopyFrom wb2.Sheets(i), ws, wsLRow
    Next
   
    '
    ' ~~> Similarly copy the other sheets
    '
End Sub

'~~> Common Sub that you can use to do the actual copying and pasting
Sub CopyFrom(wstInpt As Worksheet, wstOutpt As Worksheet, wsLastRow As Long)
    Dim lRow As Long
   
    '~~> Get Last Row of .Sheets(i)
    With wstInpt
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If
       
        .Rows("1:" & lRow).Copy wstOutpt.Rows(wsLRow)
    End With
End Sub

---

HTH

Thread moved

Koolsid
Thanks for your support. when i run your code the following error occurs:
Run-time error '1004'
application-defined or object-defined error

When i click on the debugg this highlight the line with error. For both the snapshots are attached.

maybe it should be

vb Code:

.Rows("1:" & lRow).Copy wstOutpt.Rows(wsLastRow)

@Pete: Nice Catch :)

Dear Koolsid and Westconn1:
Thank you so much guys, your suggested code is working now but there are few things remaining,
1. The code pastes the sheets in reverse order for example the first sheet in HYD15.xls/HYD16.xls is now the last sheet of the appended sheet and similarly last sheet is the first. sheet order is reversed but the data appended in these are fine.
2.Each sheet contains headers and then the data below the headers, your code pastes the whole sheet. But desired workbook should be the one displayed in snapshot.

There are four snapshots attached:
-One displays the data of the sheet 2 of HYD15.xls
-Second displays the data of the sheet 2 of HYD16.xls
-Third displays the data appended by your code
-Fourth displays the desired data.
Attachment 89645

Attachment 89646

Attachment 89647

Attachment 89648

BTW You guys are the kings of vba.Thaks alot. I know that was my mistake i couldn't present the desired workbook in right way. Thanks alot man.

Clue :)

See this code in the function. What do you think this does :)

Code:

---

.Rows("1:" & lRow).Copy wstOutpt.Rows(wsLRow)

---

Dear Koolsid,
I am still confused, I changed the row number in the above mentioned code line but still can't get that.
Attachment 89659

Another Problem is:
Attachment 89660

The two header sheet displaying in the above snapshot is present in both original sheets i.e. HYD16.xls and HYD15.xls. Kindly suggest the solution.

The first time you copy, the code

.Rows("1:" & lRow).Copy wstOutpt.Rows(wsLRow)

remains unchanged. Next time onwards you change it to

.Rows("6:" & lRow).Copy wstOutpt.Rows(wsLRow)

The best way is to check if the output sheet has any data. If the output sheet doesn't have any data then you use 1 else use 6 :)

Okay and for two headers sheets?

That could pose a problem. But then you can always check if Col 1 as "UL Assignment" or "BSC Name" and ignore/delete them?

1. You can do that either by first looping though all the sheets and deleting the rows after row 6 which has these two words and then importing the rest of the data or

2. You can import everything and then in the end and then loop though all the sheets and delete the rows after row 6 which has these two words.

I am using this code to find out if the current sheet is empty so that i can use row 1 if not empty then row 6. Error occurs object required.
Can u please debugg this?

vb Code:

If Not wsOutpt.GetBottomRow = 0 Then
        
        .Rows("1:" & lRow).Copy wstOutpt.Rows(wsLastRow)
        Else
        .Rows("6:" & lRow).Copy wstOutpt.Rows(wsLastRow)
        End If

Change

Code:

---

If Not wsOutpt.GetBottomRow = 0 Then

---

to

Code:

---

If wsLastRow = 1 then

---

Thank you so man.:thumb: that was very helpfull.
only one thing left now:o
sheet sequence
Attachment 89663

Attachment 89664

Change this line

Code:

---

Set ws = ThisWorkbook.Sheets.Add

---

to

Code:

---

Set Ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

---

Try now.

OMG!! This is perfect, u're amazing coder
I am really sorry there is 1 more problem:(
Error:
Subscritp out of range occurs at:

Attachment 89666

and by this last 2 sheets cannot be appended. Output sheet does not contain the last 2 sheets of the original sheets.

What is the value of i?

:check:Total sheets in orignal workbook is 193, but when i changed the value of "i" as 195 now the same error occurs but sheets are appended as well :bigyello:


Thank you so much koolsid:thumb:

Glad to be of Help :D

If you have JavaScript enabled you can mark the thread resolved by selecting the Mark Thread Resolved item from the Thread Tools menu. Otherwise please insert [Resolved] at the start of the Subject and select the green check mark http://www.vbforums.com/images/icons/completeclear.gif from the post icons. You may also visit the FAQ to see the snapshots on how it works.

@Koolsid:
the error mentioned above(i.e. subscript out of range) is still occuring now I have i = 197. It appends complete first two sheets (e.g HYD15.xls & HYD16.xls) and then raise this error, untill I get rid of this error I will not be able to append 3rd, 4th, 5th and 6th sheet.

when I raise the value of i to 198 it gives another error relating to sheet name at the code line

Code:

---

ws.Name = wb1.Sheets(i).Name

---

can you fix this issue too?

Can you please confirm if all the workbooks have same number of sheets?

number of sheets are not equal in all the workbooks. only difference of 1 or 2 sheets. some workbooks have title sheet in start n help sheet in the end n some don't have. when i deleted title and help sheet from all the workbooks, error still occurs.

IF

1) All the Workbooks have same number of sheet and
2) i matches the total number of sheets then you will not get an error.

is there any way to change the range of i automatically according to workbook?

Change this

Code:

---

For i = 1 To 193

---

to

Code:

---

For i = 1 To wb1.Sheets.Count

---

Perfect

:check:Thank you so much koolsid.:thumb: