Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Hi
Im using the code from the the following link: http://www.rodenbruin.nl/copy2.htm it goes like this Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim shLast As Long Dim Last As Long On Error Resume Next If Len(ThisWorkbook.Worksheets.Item("merge").Name) = 0 Then On Error GoTo 0 Application.ScreenUpdating = False Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "merge" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") 'Instead of this line you can use the code below to copy only the values 'or use the PasteSpecial option to paste the format also. 'With sh.Range(sh.Rows(3), sh.Rows(shLast)) 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = .Value 'End With 'sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy 'With DestSh.Cells(Last + 1, "A") '.PasteSpecial xlPasteValues, , False, False '.PasteSpecial xlPasteFormats, , False, False 'Application.CutCopyMode = False 'End With End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Merge already exist" End If End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function What can i add to the code if i want it to run thru all the sheets except one in specific, lets say its called "maindata". thnx |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Hi SangelNet
There are a few examples on the site But you can do this If sh.Name < DestSh.Name And sh.Name < "maindata" Then -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in message oups.com... Hi Im using the code from the the following link: http://www.rodenbruin.nl/copy2.htm it goes like this Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim shLast As Long Dim Last As Long On Error Resume Next If Len(ThisWorkbook.Worksheets.Item("merge").Name) = 0 Then On Error GoTo 0 Application.ScreenUpdating = False Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "merge" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") 'Instead of this line you can use the code below to copy only the values 'or use the PasteSpecial option to paste the format also. 'With sh.Range(sh.Rows(3), sh.Rows(shLast)) 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = .Value 'End With 'sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy 'With DestSh.Cells(Last + 1, "A") '.PasteSpecial xlPasteValues, , False, False '.PasteSpecial xlPasteFormats, , False, False 'Application.CutCopyMode = False 'End With End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Merge already exist" End If End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function What can i add to the code if i want it to run thru all the sheets except one in specific, lets say its called "maindata". thnx |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Hi Ron
Did the change. It starts doing the merge, then im getting an error on this line sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") cant seem to pint out whats wrong! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Have you also copy the LastRow function in the module ?
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in message ups.com... Hi Ron Did the change. It starts doing the merge, then im getting an error on this line sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") cant seem to pint out whats wrong! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Yes Sir, I added the lastrow function. The code im using at this point
and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Then I think that there is a empty sheet in your workbook
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in message ups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
On Oct 24, 11:37 am, "Ron de Bruin" wrote:
Then I think that there is a empty sheet in your workbook -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function No, No blanks. Actually now its merging just 2 of the sheets and then giving the error. tried doing it with new clean sheets, still. I will keep trying. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Send me the workbook private then i take a look
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in message ups.com... On Oct 24, 11:37 am, "Ron de Bruin" wrote: Then I think that there is a empty sheet in your workbook -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function No, No blanks. Actually now its merging just 2 of the sheets and then giving the error. tried doing it with new clean sheets, still. I will keep trying. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
Hi SangelNet
There are 3 sheets with data(V) in one cell in row 65338 65246 65399 So your range is to big to copy to one sheet Use Ctrl-end on each sheet and you will find your last cell -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Send me the workbook private then i take a look -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in message ups.com... On Oct 24, 11:37 am, "Ron de Bruin" wrote: Then I think that there is a empty sheet in your workbook -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function No, No blanks. Actually now its merging just 2 of the sheets and then giving the error. tried doing it with new clean sheets, still. I will keep trying. |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
On Oct 24, 2:28 pm, "Ron de Bruin" wrote:
Hi SangelNet There are 3 sheets with data(V) in one cell in row 65338 65246 65399 So your range is to big to copy to one sheet Use Ctrl-end on each sheet and you will find your last cell -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in .. . Send me the workbook private then i take a look -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... On Oct 24, 11:37 am, "Ron de Bruin" wrote: Then I think that there is a empty sheet in your workbook -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function No, No blanks. Actually now its merging just 2 of the sheets and then giving the error. tried doing it with new clean sheets, still. I will keep trying. Ron That definitely was it. Thnx so much, you've been very kind. Thnx also for the great info on your page. |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
consolidate Sheets
You are welcome
I will add a row.count check soon in the macros on that page. In my workbook merge examples I already add that in the example code -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sangel" wrote in message oups.com... On Oct 24, 2:28 pm, "Ron de Bruin" wrote: Hi SangelNet There are 3 sheets with data(V) in one cell in row 65338 65246 65399 So your range is to big to copy to one sheet Use Ctrl-end on each sheet and you will find your last cell -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in .. . Send me the workbook private then i take a look -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... On Oct 24, 11:37 am, "Ron de Bruin" wrote: Then I think that there is a empty sheet in your workbook -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "SangelNet" wrote in oglegroups.com... Yes Sir, I added the lastrow function. The code im using at this point and getting error is this: Sub merge() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Delete the sheet "MergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ThisWorkbook.Worksheets("MergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "MergeSheet" Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "MergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name And sh.Name < "maindata" Then Last = LastRow(DestSh) shLast = LastRow(sh) 'This example copies everything, if you only want to copy 'values/formats look at the example below the first example sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A") End If Next Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub __________________________________________________ _________________________________________ Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function No, No blanks. Actually now its merging just 2 of the sheets and then giving the error. tried doing it with new clean sheets, still. I will keep trying. Ron That definitely was it. Thnx so much, you've been very kind. Thnx also for the great info on your page. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Consolidate work sheets | Excel Discussion (Misc queries) | |||
CONSOLIDATE SHEETS | Excel Worksheet Functions | |||
How do I consolidate many sheets in same file to 1? | Excel Discussion (Misc queries) | |||
how to consolidate sheets | Excel Programming | |||
Consolidate sheets | Excel Worksheet Functions |