Concatentating Multiple Worksheets into One

[Guest]

I have a workbook with, say, 5 sheets (could be variable numbers of sheets)
all with the the EXACT same structure (column headers), but with vary data
and numbers of rows. I would like to automate the process of concatenating
all the sheets into one "massive" worksheet. At that time, I will be doing a
lot of other "stuff" to that massive sheet, but I need to get it there,
first.

Any ideas on a simple way to concatenate a "variable" number of worksheets
in a workbook, into either a new workbook, or, simply another worksheet (n+1
worksheets, where n= the original number of worksheets) in the same workbook?

Probably simple, but not for a noob like me. Thanks!

Pat

 

[Ron de Bruin]

Start here Pat
http://www.rondebruin.nl/copy2.htm

 

[Guest]

This looks like it should work great. I am getting an error, however, I
believe on the lastrow function (see below). Am I missing something?

For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = lastrow(DestSh) ' <-----error here on lastrow
shLast = lastrow(sh)

 

[Ron de Bruin]

You must copy the lastrow function also in the module

 

[Guest]

Works wonderfully well (now that I read the ENTIRE document!) And fast,
too! What I need to do next is figure out how to get all the rows, including
the header from the first page, then just the data from all the rest so I
have one set of headers. I am using your "copy from row 2...." approach. I
think I can figure out the rest, using each example. Thanks so much!

pat

 

[ssGuru]

Works wonderfully well (now that I read the ENTIRE document!) And fast,
too! What I need to do next is figure out how to get all the rows, including
the header from the first page, then just the data from all the rest so I
have one set of headers. I am using your "copy from row 2...." approach. I
think I can figure out the rest, using each example. Thanks so much!

pat






- Show quoted text -

I have done some extensive customizing of Ron's excellent examples. I
have the same process fully automated now and it takes any number of
files with any names as long as at least one of the worksheets in each
file has the name and structure you want. I have a button that looks
to named range values to get the folder path and sheet name. Thanks
Ron for sharing your well commented tools. His Add-In will work for
you own use or you can customize the code to fit your needs and work
transparently.
Dennis

 

[Ron de Bruin]

Hi Pat

One way is to add this line to the macro before the loop start

'Add headers from row 1 of Sheet1
Worksheets(2).Rows(1).Copy DestSh.Cells(1)

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets

 

[Guest]

What I ultimately ended up doing was inserting these items into your code:

Dim FirstPage As Boolean
FirstPage = False

Then....down where you looped through the sheets, I made this mod....

For Each sh In ThisWorkbook.Worksheets

If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
If Not FirstPage Then 'only copy headers from
first page
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy DestSh.Cells(Last
+ 1, "A")
FirstPage = True
Else
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last
+ 1, "A")
End If
End If
Next

So, maybe a bit kludgy, but it worked. I do have another little problem,
tho, along the same lines. What I am doing, after creating the mergesheet,
is that I wish to copy JUST the mergesheet to a new file, then save that
file. However, when I save (using this code), I end up saving my SOURCE
file, and not the new file I just created. Here is the subroutine I am using
to do that, once the mergesheet is created:

Sub CopySheetRoutine(result As Boolean)

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Sourcews As Worksheet
Dim Destwb As Workbook
Dim Destws As Worksheet
Dim DateString As String
Dim FolderName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Sheets("MergeSheet").Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "All Tickets"
Sheets("All Tickets").Select
Application.CutCopyMode = False
Set Sourcewb = ActiveWorkbook.ActiveSheet '<this does not seem to work

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hhmmss")
FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
MkDir FolderName
FolderName = FolderName & "\"

MsgBox "Ticket File will be stored at: " & FolderName

With Sourcewb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
.SaveAs FolderName & .Sheets(1).Name & FileExtStr,
FileFormat:=FileFormatNum
.Close False
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With


End Sub


The SET command seems to set it to the original source workbook, not the one
just created, as I had thought it would. Any ideas how I can get Sourcewb to
be pointing at the new workbook instead of the "original" source? Also,
where does one learn about all these commands like "activatesheet.paste" etc?
It is like somehow you just magically need to know they exist. Thanks
again, Ron!

 

[Ron de Bruin]

Why not use this

Dim wb As Workbook
Sheets("MergeSheet").Copy
Set wb = ActiveWorkbook

You have a new workbook now with only this sheet.

And you can use wb.SaveAs.............. now to save the file

 

[Guest]

Well...that certainly cut back on the code, but HOW do you learn these
different things like " Sheets("MergeSheet").Copy" . How does a noob look
up to know that you can do a "sheets.copy" function if you don't know what to
look for. I have 4 Excel VBA books, and they all presume you simply have
this knowledge. Any pointers to resurces you would suggest? By the way,
here is how the code ended up...thanks again!

Sub CopySheetRoutine(Foldername As String)

Dim FileExtStr As String 'used
Dim FileFormatNum As Long 'used
Dim Destwb As Workbook

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Sheets("MergeSheet").Copy
Set Destwb = ActiveWorkbook

MsgBox "Ticket File will be stored at: " & Foldername

With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
.SaveAs Foldername & .Sheets(1).Name & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

 

[Ron de Bruin]

Hi Pat

I have many books but I must confess that the most things I know I learned in the newsgroups.
I never find what I need in Books <vbg>

And Google
Try my Google Search add-in
http://www.rondebruin.nl/Google.htm

On this moment the newsgroup search is broken but I hope Google fix it soon

 

[Guest]

Ron: I saw another thread in here, where you were opening another file
(browsing), and then copying the pages into the current workbook. THAT is
what I really intended to do, at some point and now have tried to integrate
that file open function, with the copy pages (mergesheet copy subroutine).
My current code looks like the following, but it is now failing where it was
working fine, before, on the line indicated (see <<<<). Any idea why?

Sub MergeSheets(result As Boolean) 'result makes macro invisible
Dim basebook As Workbook
Dim mybook As Workbook
Dim N As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim FirstPage As Boolean

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\pklocke\My Documents\4- _
Sourcing\Spreadsheets\Pareto"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls),
*.xls", _

MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ActiveWorkbook

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
mybook.Worksheets.Copy
after:=basebook.Sheets(basebook.Sheets.Count)
mybook.Close False
Next
End If
Workbooks("Performance Metrics Template.XLS").Activate

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
MsgBox "Default Subdirectory Changed to: " & SaveDriveDir

FirstPage = False

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"
Workbooks("Performance Metrics Template.XLS").Activate
Worksheets("Mergesheet").Activate

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
If Not FirstPage Then 'only copy headers from
first page
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy DestSh.Cells(Last
+ 1, "A")
FirstPage = True
Else
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last
+ 1, "A")
'<<<<<<<<<<<<<< failing now on the above line (object error,

' assuming on sh, but no idea why.
End If
End If
Next

Application.GoTo DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Guest]

Sorry...I marked wrong line...see correct erroring line
Sub MergeSheets(result As Boolean) 'result makes macro invisible
Dim basebook As Workbook
Dim mybook As Workbook
Dim N As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim FirstPage As Boolean

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\pklocke\My Documents\4- _
Sourcing\Spreadsheets\Pareto"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), _
*.xls", MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ActiveWorkbook

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
mybook.Worksheets.Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
mybook.Close False
Next
End If
Workbooks("Performance Metrics Template.XLS").Activate

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
MsgBox "Default Subdirectory Changed to: " & SaveDriveDir

FirstPage = False

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"
Workbooks("Performance Metrics Template.XLS").Activate
Worksheets("Mergesheet").Activate

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
If Not FirstPage Then 'only copy headers from
first page
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy DestSh.Cells(Last _

+ 1, "A")
'<<<<<<<<<<<<<< failing now on the above line (object error,

' assuming on sh, but no idea why.

FirstPage = True
Else
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last _

+ 1, "A")
'<<<<<<<<<<<<<< assume it will also fail here, next worksheet.
End If
End If
Next

Application.GoTo DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Guest]

Sorry...one more thing you need to know...I am doing it this way because I
want to have all my macros, etc, stored in a file specifically for the
purpose of containing the macros, but NO data. I want folks to open my excel
macro-owning file, use the macro to select the REAL data file, have it copy
all the data into a tertiary file, and then I will process that tertiary file
(this leaves my macro workbook, and the source data file untouched).

 

[Guest]

Ignore my posts...I figured it out! I am learning!

 

[Guest]

Hi Dennis,

Please could you share that code as i've basically pasted Ron's code and it
works wonderfully but the problem is i have multiple excel files...

Cheers in advance!

Wayne