Hi,

I am newbie to this board and I am having a major problem. I want t
combine 15 workbooks to a main workbook. The main workbook looks jus
like the 15 workbooks except that it has blank rows that will be fille
in from the other workbooks. Each worksheet has a header row and th
first row where the data is entered is different on each worksheet.
have received a code from someone that does somewhat what I am lookin
for *but* it also brings in the header rows from each worksheet and i
does not populate to the empty rows in the Main Workbook. So fo
example if I have worksheet named Hardlines in the Main Workbook afte
selecting the files I want it to populate to row 2, then row 3 etc.
Also I have a multi select box, and shapes on each worksheet. These d
not need to be imported to the Main Workbook since it is already exist
Below you will find my code that someone helped me with. But I am ne
at coding so I don't know how to add new coding to it.

I appreciate your help and I am sorry about the length of thi
message.

Here is my code:

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 i
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)).Nam e = 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 remai
unique, not duplicated.
'Determine the next available row in the Main workbook for thi
particular sheet in the District workbook.
'If structures are to guard against run time error if sheet(s) is / ar
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).Cell s) < 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 shee
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 Distric
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



---
Message posted from http://www.ExcelForum.com/