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/

Does anyone have any solutions? I am even willing to start brand ne
with a totally different code

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

Sometimes it's difficult to look at other people's code and see what's going
on. And your post's format got justified to the left and a few dots were lost.

Variable names that are w,x,y,z may mean something to you, but they're usually
confusing to me. I changed some of your variable names (I find calling
something NextRow is easier than Tlr).

Also, I changed a couple of error checks. The biggest was including a nice
function from Chip Pearson that will tell you if a worksheet exists. By using a
function, it makes the primary code easier to understand (less of an
interruption of thought(?) when you're reviewing the code).

I also got rid of the way you found the last row. (.cells.find()). I think you
may have had an error by using [a1] as a reference. That refers to the
activesheet and you're not always looking at the activesheet.

Try this against a test workbook with multiple sheets:

Dim wks As Worksheet
For Each wks In Worksheets
MsgBox [a1].Address(external:=True)
Next wks

You'll always get the same result.

Well, anyway try this version to see if it's closer to what you need. It worked
ok for me in simple tests...


Option Explicit
Sub ImportDistricts2()

'Variable declarations
Dim NextRow As Long
Dim LastRow As Long
Dim wkbk As Workbook
Dim NeedHeaders As Boolean
Dim wks As Worksheet
Dim fCtr As Integer
Dim myFileNames As Variant

'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..."


myFileNames = Application.GetOpenFilename _
(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)

If IsArray(myFileNames) Then
'ok to keep going
Else
MsgBox "You did not select any workbooks." & vbCrLf & _
"Click OK to exit this macro.", 48, "Import action cancelled."
Exit Sub
End If

'Prepare Excel
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Open loop for action to be taken on all selected workbooks.
For fCtr = LBound(myFileNames) To UBound(myFileNames)
'Open the workbook(s) that were selected.
Set wkbk = Workbooks.Open(Filename:=myFileNames(fCtr))
'Open loop to act on every sheet.
For Each wks In wkbk.Worksheets
Application.StatusBar = "Processing " & wks.Name & " in " _
& myFileNames(fCtr)
'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.
If WorksheetExists(wks.Name, ThisWorkbook) Then
'do nothing
Else
With ThisWorkbook
.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Nam e = wks.Name
End With
End If

'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.

With wks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With ThisWorkbook.Worksheets(wks.Name)
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NeedHeaders = False
If NextRow = 1 Then
If IsEmpty(.Cells(1, "A")) Then
NeedHeaders = True
End If
NextRow = 2
End If
End With

'Copy the rows from the District sheet to the Main
'workbook's sheet whose name is the same.
If NeedHeaders = True Then
wks.Rows(1).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Ran ge("a1")
End If

wks.Rows("2:" & LastRow).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Cel ls(NextRow, 1)

'Continue and terminate the loop for all worksheets in the
'District workbook.
Next wks
'Close the District workbook without saving it.
wkbk.Close savechanges:=False
'Continue and terminate the loop for the selected District workbooks.
Next fCtr

'Restore Excel.
With Application
.ScreenUpdating = True
.EnableEvents = True
.StatusBar = False
End With

'Message box to inform user the job is complete.
MsgBox "The import is complete.", 64, "Done !!"
End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = Len(WB.Worksheets(SheetName).Name) 0
End Function




"happy <" wrote:

Hi,

I am newbie to this board and I am having a major problem. I want to
combine 15 workbooks to a main workbook. The main workbook looks just
like the 15 workbooks except that it has blank rows that will be filled
in from the other workbooks. Each worksheet has a header row and the
first row where the data is entered is different on each worksheet. I
have received a code from someone that does somewhat what I am looking
for *but* it also brings in the header rows from each worksheet and it
does not populate to the empty rows in the Main Workbook. So for
example if I have worksheet named Hardlines in the Main Workbook after
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 do
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 new
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 this
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 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).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 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


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

--

Dave Peterson

Thank you very much Dave for your response. I am going to try it out.
I will let you know the result

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

So I tried the updated code and it says "Can't Execute Code in Brea
Mode". What does this mean. I have very little coding experience an
your help will be greatfully appreciated

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

And so the saga continues,

It is working!! I figured out the what the error message was, but no
what I need to do is assign a range for each sheet. Because each shee
begins on a different row. For example on one sheet it begins on A
and another one it begins on A7. So now here is my latest request i
there a way to assign each sheet a range in this code??
Many Many Many thanks you guys rock!

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

How do you know what sheet has what header rows?

Can you give a list? And if the sheet isn't on that list, what do you do?

Look for the "select case" statement added in the code. Modify that to include
all your sheet names. Use the "case else" for the most common number of
headerrows--so you don't have to type all the worksheet names that use that
number.

Option Explicit
Sub ImportDistricts2()

'Variable declarations
Dim NextRow As Long
Dim LastRow As Long
Dim wkbk As Workbook
Dim NeedHeaders As Boolean
Dim wks As Worksheet
Dim fCtr As Integer
Dim myFileNames As Variant
Dim HeaderRows As Long

'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..."


myFileNames = Application.GetOpenFilename _
(FileFilter:="Excel files (*.xls), *.xls", MultiSelect:=True)

If IsArray(myFileNames) Then
'ok to keep going
Else
MsgBox "You did not select any workbooks." & vbCrLf & _
"Click OK to exit this macro.", 48, "Import action cancelled."
Exit Sub
End If

'Prepare Excel
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Open loop for action to be taken on all selected workbooks.
For fCtr = LBound(myFileNames) To UBound(myFileNames)
'Open the workbook(s) that were selected.
Set wkbk = Workbooks.Open(Filename:=myFileNames(fCtr))
'Open loop to act on every sheet.
For Each wks In wkbk.Worksheets
Application.StatusBar = "Processing " & wks.Name & " in " _
& myFileNames(fCtr)
'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.
If WorksheetExists(wks.Name, ThisWorkbook) Then
'do nothing
Else
With ThisWorkbook
.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Nam e = wks.Name
End With
End If

'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.

With wks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With ThisWorkbook.Worksheets(wks.Name)
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NeedHeaders = False
If NextRow = 1 Then
If IsEmpty(.Cells(1, "A")) Then
NeedHeaders = True
End If
NextRow = 2
End If
End With

Select Case LCase(wks.Name)
Case Is = "sheet1": HeaderRows = 1
Case Is = "sheet2": HeaderRows = 7
Case Is = "sheet3": HeaderRows = 12
Case Else
HeaderRows = 2
End Select

'Copy the rows from the District sheet to the Main
'workbook's sheet whose name is the same.
If NeedHeaders = True Then
wks.Rows(1 & ":" & HeaderRows).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Ran ge("a1")
End If

wks.Rows(HeaderRows + 1 & ":" & LastRow).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Cel ls(NextRow, 1)

'Continue and terminate the loop for all worksheets in the
'District workbook.
Next wks
'Close the District workbook without saving it.
wkbk.Close savechanges:=False
'Continue and terminate the loop for the selected District workbooks.
Next fCtr

'Restore Excel.
With Application
.ScreenUpdating = True
.EnableEvents = True
.StatusBar = False
End With

'Message box to inform user the job is complete.
MsgBox "The import is complete.", 64, "Done !!"
End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = Len(WB.Worksheets(SheetName).Name) 0
End Function


"happy <" wrote:

And so the saga continues,

It is working!! I figured out the what the error message was, but now
what I need to do is assign a range for each sheet. Because each sheet
begins on a different row. For example on one sheet it begins on A2
and another one it begins on A7. So now here is my latest request is
there a way to assign each sheet a range in this code??
Many Many Many thanks you guys rock!!

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

--

Dave Peterson