Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
why do all excel worksheets/workbooks close when I close one? | Excel Discussion (Misc queries) | |||
Open Close workbooks | Excel Discussion (Misc queries) | |||
Why does Excel close all workbooks? | Setting up and Configuration of Excel | |||
Workbooks(). close intermittent failure | Excel Programming | |||
help with macro to open and close workbooks | Excel Programming |