Combining/Merging Workbooks in need of help!!!!!!!

[sehrlich]

Hello,

Sorry about the length of this post, but I really need your help. So please bear with me.

I would like to merge a multitude of workbooks 5 - 15 (depending on the source) to populate to the main workbook. Keep in mind though, that each workbook will have similar data, but there maybe some worksheets that have data and some that don't. There are 14 worksheets in the workbook. So, what I need to do is create a macro that will
* Merge the workbooks without opening them
* When merging to the worksheets it will populate to the
worksheet in the Main workbookand will automatically go to the
next row
I recently found a macro on that will do this on the boards but, the infomation populates to a new worksheet. So for example, if I had a worksheet called Footwear in the Main Workbook it would create a Footwear 1, Footwear 2, Footwear 3, etc.

If anyone has any ideas please let me know. I am attaching the macro for your review. It is kind of lengthy so you may want to copy it or print it out.

Thank you for your help!!

Macro:
Option Explicit

Sub CopyWorksheets2()

Dim filenames As Variant
Dim strActiveBook As String
Dim strSourceDataFile As String
Dim wSht As Worksheet, wSht2 As Worksheet
Dim allwShts As Sheets, allwShts2 As Sheets
Dim Sheetname As String, response As String
Dim counter As Integer, intResponse As Integer


Application.DisplayAlerts = False
intResponse = MsgBox("This macro will copy all worksheets from selected files to the current workbook. Continue?", vbOKCancel, "Copy Worksheets to Current File")
If intResponse = vbOK Then
strActiveBook = ActiveWorkbook.Name

' Create array of filenames; the True is for multi-select
filenames = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , , , True)
On Error GoTo 1000
If filenames = False Then Exit Sub
1000
On Error GoTo 0

counter = 1

' ubound determines how many items in the array
On Error GoTo quit

response = MsgBox("Retain Original Worksheet Names? (If No, then each copied worksheet will be given the name of the Excel file from which it came.", vbYesNo, "Copy Worksheets")
Application.ScreenUpdating = False
If response = vbNo Then
While counter <= UBound(filenames)

'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
Set allwShts = Worksheets
For Each wSht In allwShts
Workbooks(strSourceDataFile).Activate

If wSht.Visible = True Then
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
Sheetname = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
Workbooks(strActiveBook).Activate
'Check to see if a Sheet already has the name
If SheetExists(Sheetname) = True Then
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4) & "(" & wSht.Index & ")"
Else
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
End If
End If

Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
Else
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
'Copy all worksheets except "Specifications"
Set allwShts = Worksheets
For Each wSht In allwShts
If wSht.Visible = True Then
Workbooks(strSourceDataFile).Activate
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
End If
Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
End If

quit:
If Err <> 0 Then
MsgBox "An Error Occurred Trying to open the File. Please close any open Excel files and try again", vbOKOnly + vbExclamation, "File Open Error"
On Error GoTo 0
End If
End If
Set allwShts = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True



End Sub
Private Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
On Error GoTo 0
End Function

• 

 

[Tom Urtis]

figaro - - what exactly is the problem you need to solve?

patti - - to follow up, you wrote this:

BTW, we did answer questions #3 and #4...AGAIN, in laymen's terms:
#3: We want to automate the process so that all the Admin has to do is click a button in the template to import the information in order to consolidate it all into ONE report.
#4: The Admins don't need to know the source file path because the regions and districts will be sending their files to them via email; therefore, they will save it to their local drive. In other words, one Admin will be getting up to 15 separate reports. That's why we want the code to prompt them for the files they want to consolidate.

No, that did not answer the questions. Take a close look at my question #3, dealing with why the workbooks are not wanted to be open. It stemmed from this quote from the first post:
"* Merge the workbooks without opening them"
Your attempt at clarifying this did not answer, or even touch the issue of opening or not opening the workbooks.

My question # 4 was whether the AAs know the file path, which you say they don't need to. So how would they know where to look, is the path hard coded, if so what is the path, and not is someone expecting an Open dialog or Browser dialog to select the workbooks.

 

[sehrlich]

OK I think I have answered all the questions that needed to be answered. But if there is anything that needs clarification please let me know. Sorry in advance about the length but please bear with me.

1) What is the essence of the request? That all data in all worksheets of all files in a certain folder path get "merged" to a single worksheet in a main workbook?
Maybe “Merge” is not the correct word. I am trying to “Combine” the files to the one workbook. So, I have six regions, each region has 10-15 districts. Each district will complete a workbook. Upon completion they will send the workbook back to the regional office. All the workbooks have the same worksheet names and same column setup. What I need to do is combine the workbooks to one main workbook. So each sheet will populate to the same sheet and just go to the next row. The main workbook looks just like the other workbooks except it is blank and has a Introduction Sheet which tells the Administrative Assistant how to merge and to select the Combine File Button.

(2) What exactly do you mean by "merged"?
Forget about the word merge let’s re-look at this by combining workbooks.

(3) Why do you not want the workbooks to open? There is a way to keep them closed and extract data programmatically but that generally involves simulating paste link formulas in a loop, which for 14 sheets times 10 workbooks times however many cells there are with data on each sheet would be a hell of a lot of formulas and extra work in the macro.

The reason that I do not want the workbooks to open is so the Admins can just select the workbooks and they will automatically combine to the Main Regional Workbook. Instead, currently they are cutting and pasting each worksheet to the Main Regional workbook. So for example, if I selected District 1 and District 2 the information will populate to the Main Regional workbook and worksheets. So far, I have the macro that I found (which is included from the previous post) works, but it also creates separate worksheets instead populating the information to one worksheet. So I am trying to see if there is a code that I can just populate to one worksheet instead of creating extra sheets. For example, the Regional Workbook has a Worksheet named Hardlines. When I select District 1 and District 2, it won't populate to Hardlines worksheet it creates Hardlines (2), Hardlines (3). Keep in mind though, The District Managers are only allowed to fill out 3 rows on each worksheet and sometimes they will not fill out every worksheet.
(4)
Is the source file path known?

Currently these regions are not on a server to the corporate office. So, everything will be on their C drive. So if, we were to guide them to a file path it would probably be C:Mydocuments\Operations Reports\name of district.

Many Thanks ray:

 

[Tom Urtis]

This macro tested fine on XL2K3 XP. It will add, but not duplicate, the name(s) of worksheet(s) in the Main workbook that are found in the District workbook(s) which had not previously existed in the Main workbook. It will append to the next available row in each case for each sheet and ignore worksheets with no data. A bunch of notes were put in so you can follow along with how and why this macro does what it does.


Sub ImportDistricts()
'Instructional Message Box
MsgBox "Click OK to access the Open dialog." & vbCrLf & _
"Navigate to the folder path that contains" & vbCrLf & _
"the District workbooks you want to import." & vbCrLf & vbCrLf & _
"When you get inside that folder path," & vbCrLf & _
"use your mouse to select one workbook," & vbCrLf & _
"or use the Ctrl button with your mouse" & vbCrLf & _
"to select as many District workbooks" & vbCrLf & _
"as you want from that same folder path." & vbCrLf & vbCrLf & _
"There is a limit of one path per macro run," & vbCrLf & _
"but as many workbooks per path as you want." & vbCrLf & vbCrLf & _
"Please click OK to get started.", 64, "Instructions..."
'Variable declarations
Dim Tlr As Long, Alr As Long, u As String, v As String, w As Worksheet, x As Integer, y As Integer, z As Variant
z = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
'Prepare Excel
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Open loop for action to be taken on all selected workbooks.
On Error Resume Next
For x = 1 To UBound(z)
'Error handler within code if Cancel is clicked in Open dialog.
If Err.Number = 13 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You did not select any workbooks." & vbCrLf & _
"Click OK to exit this macro.", 48, "Import action cancelled."
On Error GoTo 0
Err.Clear
Exit Sub
End If
'Open the workbook(s) that were selected.
Workbooks.Open (z(x))
'Open loop to act on every sheet.
For Each w In ActiveWorkbook.Worksheets
'Identify sheet name
v = w.Name
'Determine if the sheet name in the District workbook also exists in the Main workbook.
'If not, create one in the Main workbook. If so, disregard and move on.
Err.Clear
On Error Resume Next
u = ThisWorkbook.Worksheets(v).Name
If Err.Number <> 0 Then
With ThisWorkbook
.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = v
End With
End If
On Error GoTo 0
Err.Clear
'At this point we know there is a sheet name in the Main workbook
'for every sheet name in the District workbook, which will remain unique, not duplicated.
'Determine the next available row in the Main workbook for this particular sheet in the District workbook.
'If structures are to guard against run time error if sheet(s) is / are blank.
If Application.CountA(w.Cells) <> 0 Then
On Error Resume Next
Alr = w.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
On Error GoTo 0
Else
Alr = 1
End If
If Application.CountA(ThisWorkbook.Worksheets(v).Cells) <> 0 Then
Tlr = ThisWorkbook.Worksheets(v).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Else
Tlr = 1
End If
'Copy the rows from the District sheet to the Main workbook's sheet whose name is the same.
w.Rows("1:" & Alr).Copy ThisWorkbook.Worksheets(v).Cells(Tlr, 1)
'Continue and terminate the loop for all worksheets in the District workbook.
Next w
'Close the District workbook without saving it.
ActiveWorkbook.Close False
'Continue and terminate the loop for the selected District workbooks.
Next x
'Restore Excel.
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Message box to inform user the job is complete.
MsgBox "The import is complete.", 64, "Done !!"
End Sub

 

[sehrlich]

We are almost there with the coding. The problem that I am having now is when the information is importing from the other files it creates a new header row and the information below it instead of just going to cell A7 then A8. Is there a way of importing the information without importing the header rows?

Tom if you are there I sent you an email with a picture of what I am talking about.

Thank you very much for help.

 

[Tom Urtis]

Tom if you are there I sent you an email with a picture of what I am talking about.

Stop sending me emails. Whatever you are sending is causing my email client to error. Just post what you want to say on this board, or download Colo's HTML maker through the link on this page and post the image here.

Try changing this line
w.Rows("1:" & Alr).Copy ThisWorkbook.Worksheets(v).Cells(Tlr, 1)

to this
w.Rows("2:" & Alr).Copy ThisWorkbook.Worksheets(v).Cells(Tlr, 1)

 

[sehrlich]

Tom,

Sorry about your email problem but I am having a problem posting the example to this board. I have downloaded the program but it pops an error message to me saying it Cannot Find Project or Library; Missing:Microsoft Outlook 9.0 Object.

The correction to the code did not work, it is still pulling in the information the same way and if there is blank information on a worksheet it pulls in the Header Row and empty cells as well.

I appreciate your help and time that you have put in to make this work.

 

[sehrlich]

Is there a way to just copy and paste the data from the rows just below the header?

 

[Tom Urtis]

It's a long time before I forget this thread.

You wrote:
"some worksheets that have data and some that don't."

To me that sounds like some worksheets are blank. To you and Patti it sounds like something else.
It later sounds like there are headers on each sheet.
What row those headers are on is still a mystery, and since you and Patti don't appreciate people asking you questions who are trying to help, I am guessing it is row 1.
Another mystery is what column the data starts on. No actual ranges have ever been referenced, so again, to avoid giving you further question agony, I am guessing column A.

You wrote:
"Merge the workbooks without opening them"
To me that sounds like you don't want the workbooks to be opened in the import process. As it turns out, it is OK to open them in the macro.

Patti rudely wrote:
"Alrighty then TOM...Look, we created a new post because we weren't getting any responses from this one...well, guess what, someone responded to the new post (MISSION IMPOSSIBLE ---> Multiple File Import) immediately and he was quite nice about it too.
BTW, we did answer questions #3 and #4"

BTW Patti, no you did not.


You were never specific of the file path so I coded a multi-select Open dialog. You're welcome.

Then my email crashes this morning from whatever uninvited attachment you sent me. Thanks a lot.

On top of that, you double-post to further confuse the issue, and protest when a helpful tip is offered that duplicate posting only hurts your cause.

This will be my final post on this thread. I cannot keep guessing at your riddles while your office friend sneaks in and out with baseless cheap shots when my email is messed up while I was the one who volunteered to assist.

You both should take a look at how difficult you have made this process for yourselves and for me. Your business deadlines are not the fault of anyone on this board.

If this does not work, someone else will need to assist from here, but I wanted to make one last attempt on the off-chance that you told me or subtley hinted at everything I need to know.


Sub ImportDistricts2()
'Instructional Message Box
MsgBox "Click OK to access the Open dialog." & vbCrLf & _
"Navigate to the folder path that contains" & vbCrLf & _
"the District workbooks you want to import." & vbCrLf & vbCrLf & _
"When you get inside that folder path," & vbCrLf & _
"use your mouse to select one workbook," & vbCrLf & _
"or use the Ctrl button with your mouse" & vbCrLf & _
"to select as many District workbooks" & vbCrLf & _
"as you want from that same folder path." & vbCrLf & vbCrLf & _
"There is a limit of one path per macro run," & vbCrLf & _
"but as many workbooks per path as you want." & vbCrLf & vbCrLf & _
"Please click OK to get started.", 64, "Instructions..."
'Variable declarations
Dim Tlr As Long, Alr As Long, u As String, v As String, w As Worksheet, x As Integer, y As Integer, z As Variant
z = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)
'Prepare Excel
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Open loop for action to be taken on all selected workbooks.
On Error Resume Next
For x = 1 To UBound(z)
'Error handler within code if Cancel is clicked in Open dialog.
If Err.Number = 13 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You did not select any workbooks." & vbCrLf & _
"Click OK to exit this macro.", 48, "Import action cancelled."
On Error GoTo 0
Err.Clear
Exit Sub
End If
'Open the workbook(s) that were selected.
Workbooks.Open (z(x))
'Open loop to act on every sheet.
For Each w In ActiveWorkbook.Worksheets
'Identify sheet name
v = w.Name
'Determine if the sheet name in the District workbook also exists in the Main workbook.
'If not, create one in the Main workbook. If so, disregard and move on.
Err.Clear
On Error Resume Next
u = ThisWorkbook.Worksheets(v).Name
If Err.Number <> 0 Then
With ThisWorkbook
.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = v
End With
End If
On Error GoTo 0
Err.Clear
'At this point we know there is a sheet name in the Main workbook
'for every sheet name in the District workbook, which will remain unique, not duplicated.
'Determine the next available row in the Main workbook for this particular sheet in the District workbook.
'If structures are to guard against run time error if sheet(s) is / are blank.
If Application.CountA(w.Columns(1)) = 1 Then
Alr = 2
Else
Alr = w.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
If Application.CountA(ThisWorkbook.Worksheets(v).Cells) <> 0 Then
Tlr = ThisWorkbook.Worksheets(v).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Else
Tlr = 1
End If
'Copy the rows from the District sheet to the Main workbook's sheet whose name is the same.
w.Rows("2:" & Alr).Copy ThisWorkbook.Worksheets(v).Cells(Tlr, 1)
'Continue and terminate the loop for all worksheets in the District workbook.
Next w
'Close the District workbook without saving it.
ActiveWorkbook.Close False
'Continue and terminate the loop for the selected District workbooks.
Next x
'Restore Excel.
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Message box to inform user the job is complete.
MsgBox "The import is complete.", 64, "Done !!"
End Sub

 

[sehrlich]

The code that I received still has some issues. It is bringing in the header rows from the other workbooks not populating the data underneath the header in the Master Workbook. Could somebody please help me with this.

I really appreciate anyones help in this manner.

 

[aeroballer]

Is there a way to make this code only add data from one worksheet and only 4 rows?