Copy sheets into 1 workbook

Jokada

New Member
Joined
Dec 6, 2005
Messages
12
Hi,

I have about 50 xls files with each 6 sheets.

Now I would like to create 6 workbooks with 50 sheets.

What I need:

for all files in a certain directory:
copy all sheet(1) to a given workbook(1.xls) as a new sheet.
copy all sheet(2) to given workbook(2.xls) as a new sheet.
... for all 6 sheets

I found something similar here http://vbaexpress.com/kb/getarticle.php?kb_id=773
but this copies all info into 1 worksheet...

Can someone help me out on this one?

Thanks in advance!
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
I do not have time to do the complete job for you. Hopefully you can use this as a basic structure.

http://www.mrexcel.com/board2/viewtopic.php?t=145246&highlight=

*Instead of a single master workbook you will need to have your 6 open.
*You will not need to worry about row numbers.
*You then need to amend Private Sub Transfer_data() to copy sheets to your 6 workbooks. Code something like :-
Code:
Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
    '---------------------------------
    FromBook.Worksheets(1).Copy _
        after:=Workbooks("Book1.xls").Worksheets(Workbooks("Book1.xls").Worksheets.Count)
    FromBook.Worksheets(2).Copy _
        after:=Workbooks("Book2.xls").Worksheets(Workbooks("Book2.xls").Worksheets.Count)
    '--------------------------------------------
    Workbooks(FromBook).Close savechanges:=False
End Sub
 

Jokada

New Member
Joined
Dec 6, 2005
Messages
12
Hi,

I've tested the code but it gives me a "Out of range error" at the fisrt copy statement:

Code:
Private Sub Transfer_data()

Dim Path            As String 'string variable to hold the path to look through
Dim FileName        As String 'temporary filename string variable
Dim tWB             As Workbook 'temporary workbook (each in directory)
 
Path = ThisWorkbook.Path

If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
        Path = Path & Application.PathSeparator 'add "\"
End If

i = 0

FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable
    Do Until FileName = "" 'loop until all files have been parsed
         If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
            If (InStr(FileName, "01.06.xls") Or InStr(FileName, "2006.xls")) Then
            Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
              If (i < 5) Then
                    
                    tWB.Sheets("Katalogus NL").Select
                    tWB.Sheets("Katalogus NL").Copy after:=Workbooks("1.xls").Worksheets(Workbooks("1.xls").Worksheets.Count)   '------errors here
                    Windows("FileName").Activate
                    tWB.Sheets("Aankoopprijs").Select
                    tWB.Sheets("Aankoopprijs").Copy after:=Workbooks("2.xls").Worksheets(Workbooks("2.xls").Worksheets.Count)
                    Windows("FileName").Activate
                    tWB.Sheets("Verkoopprijs").Select
                    tWB.Sheets("Verkoopprijs").Copy after:=Workbooks("3.xls").Worksheets(Workbooks("3.xls").Worksheets.Count)
                    Windows("FileName").Activate
                    tWB.Sheets("Katalogus FR").Select
                    tWB.Sheets("Katalogus FR").Copy after:=Workbooks("4.xls").Worksheets(Workbooks("4.xls").Worksheets.Count)
                    Windows("FileName").Activate
                    tWB.Sheets("Prix d'achat").Select
                    tWB.Sheets("Prix d'achat").Copy after:=Workbooks("5.xls").Worksheets(Workbooks("5.xls").Worksheets.Count)
                    Windows("FileName").Activate
                    tWB.Sheets("Prix de vente").Select
                    tWB.Sheets("Prix de vente").Copy after:=Workbooks("6.xls").Worksheets(Workbooks("6.xls").Worksheets.Count)
                    Windows("FileName").Activate
                    'ActiveWorkbook.Close savechanges:=False
                    i = i + 1
                End If
                
            tWB.Close False 'close temporary workbook without saving
            End If
        End If
        FileName = Dir() 'set next file's name to FileName variable
    Loop

End Sub

Any ideas whan I'm doing wrong here?
I've got all XLS files open he should write to...
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127

ADVERTISEMENT

That error usually means that it cannot find the named workbook or worksheet.
 

Jokada

New Member
Joined
Dec 6, 2005
Messages
12
Hi,

I got it to work now:
Code:
tWB.Sheets(1).Select 
tWB.Sheets("1").Copy after:=Workbooks("1.xls").Worksheets(Workbooks("1.xls").Worksheets.Count)
Windows(FileName).Activate

I replaced the actual sheet names by their index.
Also removed the quotes in Windows(FileName).Activate :oops:

Anyway Brian big thanks for the help!
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,344
Office Version
  1. 365
Platform
  1. Windows
Charles

I know you have a solution but I just want to point out that you don't need to activate/select in the code.

With this line you have created a reference to the newly opened workbook.
Code:
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable

You can use this in later code like this.
Code:
  tWB.Sheets("Katalogus NL").Copy after:=Workbooks("1.xls").Worksheets(Workbooks("1.xls").Worksheets.Count)   '------errors here
                    tWB.Sheets("Aankoopprijs").Copy after:=Workbooks("2.xls").Worksheets(Workbooks("2.xls").Worksheets.Count)
                    tWB.Sheets("Verkoopprijs").Copy after:=Workbooks("3.xls").Worksheets(Workbooks("3.xls").Worksheets.Count)
                    tWB.Sheets("Katalogus FR").Copy after:=Workbooks("4.xls").Worksheets(Workbooks("4.xls").Worksheets.Count)
                    tWB.Sheets("Prix d'achat").Copy after:=Workbooks("5.xls").Worksheets(Workbooks("5.xls").Worksheets.Count)
                    tWB.Sheets("Prix de vente").Copy after:=Workbooks("6.xls").Worksheets(Workbooks("6.xls").Worksheets.Count)
Obviously change this code to use the indexes as mentioned in your last post.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,020
Messages
5,834,986
Members
430,331
Latest member
Syed Yasir Hannan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top