So close yet so far - combining workbooks

[happy]

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

 

[happy]

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

 

[Dave Peterson]

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)).Name = 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).Range("a1")
End If

wks.Rows("2:" & LastRow).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Cells(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

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

 

[happy]

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

 

[happy]

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

 

[happy]

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!

 

[Dave Peterson]

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)).Name = 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).Range("a1")
End If

wks.Rows(HeaderRows + 1 & ":" & LastRow).Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name).Cells(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]

Thank you for getting back to me.

OK what I have done is outline each sheet name and their range wher
the user will be entering their information. The ranges are the onl
area where I need to capture. The Main workbook is identical to thi
except there are blank lines for the information to go to.

"Hardlines" (A8:H17);(A22:H31);(A36:H46)
"Softlines-TeamSports" (A8:G17);(A23:G33);(A36:G46)
"Footwear Merchandise"(A8:G18);(A22:G22)
"Pricing" range (A12:G22)
"Advertising" range (A12:G22);(A26:G26)
"Operational" range (A8:F18)
"Distribution Center" (A8:F18)
"IS Issues" range (A11:G21)
"Construction and Visual" (A8:F18)
"Competition" (A8:H18)
"Real Estate" (A8:F18)
"Other" (A10:F20)

As you can see there are some duplications so if I have a sheet wit
three header rows do I just count from the top when using case else?
I hope I am on the right track.

Also just one more question, if a worksheet doesn't have any data o
there are blank rows is it possible to add this to the code so th
blank informatin doesn't come over. It is currently happening in th
code now.

You don't know how much I appreciate your help. I am looking forwar
to hearing your answer

 

[Dave Peterson]

I _think_ that this does what you want.

It looks at each row in each of those ranges (A8:h17, a22:h31, A36:h46) for
example. If that row isn't used (counta()= 0), then it doesn't copy that row.

I'm not sure how the headers should work, but I took a guess.

Try it against a copy of your workbook--it may do stuff that I didn't understand
and that you didn't want.


Option Explicit
Sub ImportDistricts2()

'Variable declarations
Dim NextRow As Long
Dim wkbk As Workbook
Dim wks As Worksheet
Dim fCtr As Integer
Dim myFileNames As Variant
Dim myAddr As Variant
Dim aCtr As Long
Dim myRow As Range

'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)).Name = 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.

Select Case LCase(wks.Name)
Case Is = "hardlines"
myAddr = Array("A8:H17", "A22:H31", "A36:H46")
Case Is = "softlines-teamsports"
myAddr = Array("a8:G17", "A23:G33", "A36:G46")
Case Is = "footwear merchandise"
myAddr = Array("A8:G18", "A22:G22")
Case Is = "pricing"
myAddr = Array("A12:G22")
Case Is = "advertising"
myAddr = Array("A12:G22", "A26:G26")
Case Is = "operational"
myAddr = Array("a8:f18")
Case Is = "distribution center"
myAddr = Array("a8:F18")
Case Is = "is issues"
myAddr = Array("A11:G21")
Case Is = "construction and visual"
myAddr = Array("A8:F18")
Case Is = "competition"
myAddr = Array("a8:h18")
Case Is = "real estate"
myAddr = Array("A8:F18")
Case Else
myAddr = Array("a10:f20")
End Select

For aCtr = LBound(myAddr) To UBound(myAddr)
For Each myRow In wks.Range(myAddr(aCtr)).Rows
If Application.CountA(myRow) = 0 Then
'do nothing
Else
With ThisWorkbook.Worksheets(wks.Name)
NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If aCtr = LBound(myAddr) Then
If NextRow < _
wks.Range(myAddr(aCtr)).Rows.Count Then
wks.Range("1:" _
& wks.Range(myAddr(aCtr)).Row - 1).Copy _
Destination:=.Range("a1")
NextRow _
= wks.Range(myAddr(aCtr)).Rows.Count + 1
End If
End If
myRow.Copy _
Destination:=ThisWorkbook.Worksheets(wks.Name) _
.Cells(NextRow, "A")
NextRow = NextRow + 1
End With
End If
Next myRow
Next aCtr
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]

Thanks for the updated macro unfortunately it did not work. Only th
information on the Hardlines Sheet got pulled and what showed up wher
the headers and the rows with the information. None of the othe
information came in from the workbook.

I hope there is just a minor tweek that needs to be done. Thank yo
once again for all your help

 

[happy]

Dave if you are there it is me again.....

I tried the code again and it is working to an extent. For example, i
I have information on Row A8 on my "other" page it brings it down
rows. Or if I have information on the Hardlines page in the firs
section it brings the information down to the last section. I hop
that this is clear, if not let me know and I can send a snapshot o
what is happening.

Thanks again for your help

 

[Dave Peterson]

I'm still confused.

And this is a text newsgroup. Most people (me included) don't open attachments
and don't want to see large posts. (It's not fair to people who pay for
internet access by the minute (still in Europe????) or for people who use dialup
access (me!).)

For hardlines only, you gave 3 ranges:
A8:H17, A22:H31, A36:H46

The code I gave looks at each row in each range looking to see if it was used.
If not, it skips that row.

If that row was used, it copies it to the combined "hardlines" worksheet. It
uses column A to determine the next available row.

If that's not what's supposed to happen, please describe it again.

(maybe a8:h17 is one block--all gets copied or none gets copied???)

 

[happy]

Soffy if it sounded a little confusing, but your understanding of wha
is suppose to happen is right on track but for some reason when th
file is imported it is doing something totally differnt. If on th
"hardlines" worksheet I have data in rows A8, A9, and A10 and nothin
else on the worksheet, it will populate to rows A36,A37, and A38 on th
Main Worksheet. Or on the "other" worksheet I had information on row
A8 and A10 and it populated to rows A13 and A14.

I hope this clears things up and once again I appreciate your help.

Thank yo

 

[Dave Peterson]

I thought it did that.

Can you skinny down your master workbook and an imported one. Try to make it
small (zip it).

And send it to my email address--not the newsgroup.

In fact, if you included a version of what the hardlines worksheet should be in
the master, I can compare and see what I'm doing wrong.

Please skinny it down, though. I'm on a dialup.

(And it's past my bedtime and there's work tomorrow. So it might be a few hours
before I can even open it.)

 

[happy]

Sorry I haven't gotten back to you sooner, but I am still having som
issues. The good news is that it will import the information to al
the spreadsheets. The bad news is that it still imports the Header
only on 6 of the workseets. Which are after the first 4 and before th
last 4 worksheets of the 14 worksheets. Now on the 6 worksheets th
headers are coming from the worksheets being imported and placed abov
the original header in the Main Workbook.


Does it make sense to have several case statements based on the amoun
of headers per sheet.
So for example,

First Case Statement could be for Hardlines, (with 5 headers)

Second Case Statement could be for Softlines (3 Headers)

Third Case Statement could be for Footwear Merchandise, Advertising (
Headers)

Final Case Statement would be for the remainder worksheets with
header.

I hope this makes sense to you. I really appreciate the time you hav
put into it to make this work

 

[Dave Peterson]

The private email version that I sent back didn't copy the headers. It copied
the worksheet and removed the existing data (except for the portion that is used
to receive the data).

Did you not get that?

 

[happy]

Thanks for your reply,

I did get your code but it is still not working probably. It stil
seems to import headers only on 6 worksheets. If you would like I ca
send you the code via private email.

Please advise,

Happ

 

[Dave Peterson]

This portion of the code:

If WorksheetExists(wks.Name, ThisWorkbook) Then
'do nothing
Else
With ThisWorkbook
'get headers and all the layout
wks.Copy _
after:=.Sheets(.Sheets.Count)
'clean any data in that existing sheet
'so that empty rows can be avoided
With .Worksheets(wks.Name)
For aCtr = LBound(myAddr) To UBound(myAddr)
.Range(myAddr).ClearContents
Next aCtr
End With
End With
End If

copies headers--in fact, it copies the whole worksheet if it didn't exist in the
receiving workbook.

Are you sure the worksheet has headers?