Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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/

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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

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 <" wrote:

Thank you for getting back to me.

OK what I have done is outline each sheet name and their range where
the user will be entering their information. The ranges are the only
area where I need to capture. The Main workbook is identical to this
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 with
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 or
there are blank rows is it possible to add this to the code so the
blank informatin doesn't come over. It is currently happening in the
code now.

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

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


--

Dave Peterson

  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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



  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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

  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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 <" wrote:

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

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

Thanks again for your help.

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


--

Dave Peterson

  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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

  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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 <" wrote:

Soffy if it sounded a little confusing, but your understanding of what
is suppose to happen is right on track but for some reason when the
file is imported it is doing something totally differnt. If on the
"hardlines" worksheet I have data in rows A8, A9, and A10 and nothing
else on the worksheet, it will populate to rows A36,A37, and A38 on the
Main Worksheet. Or on the "other" worksheet I had information on rows
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 you

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


--

Dave Peterson

  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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



  #16   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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 <" wrote:

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

Does it make sense to have several case statements based on the amount
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 (2
Headers)

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

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

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


--

Dave Peterson

  #17   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default So close yet so far - combining workbooks

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

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

  #18   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default So close yet so far - combining workbooks

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?



"happy <" wrote:

Thanks for your reply,

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

Please advise,

Happy

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


--

Dave Peterson

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
why do all excel worksheets/workbooks close when I close one? Penny Excel Discussion (Misc queries) 1 November 29th 06 03:49 AM
Open Close workbooks bbc1 Excel Discussion (Misc queries) 2 August 28th 05 11:24 AM
Why does Excel close all workbooks? JVernon Setting up and Configuration of Excel 1 July 5th 05 10:38 PM
Workbooks(). close intermittent failure Alan[_18_] Excel Programming 1 November 15th 03 04:22 PM
help with macro to open and close workbooks aneurin Excel Programming 1 September 24th 03 02:14 AM


All times are GMT +1. The time now is 05:25 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"