![]() |
VBA Help on Not Copying Specific Worksheets
Hi, In the following function below I am trying to modify Ron de Bruin function for merge cells from all or some worksheets and am running into problems with the entry: For Each sh In Sheets(Array("Sheet1", Sheet2" etc.). I have 24 tabs that can be used for data entry and 2 reserved worksheets for instructions and other macro buttons. You see that I tried a couple of options that are commented out. The error message is a runtime error code 9 and hilites the code in yellow below. Could someone please assist in educating me on the correct way or other options available? Thanks in advance 'Copy a range of each sheet 'This example use the function LastRow Sub Test1() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long On Error Resume Next If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then On Error GoTo 0 Application.ScreenUpdating = False Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Master" 'For Each sh In ThisWorkbook.Worksheets 'If sh.Name < DestSh.Name Then 'If Left(sh.Name, 4) = "hub" Then For Each sh In Sheets(Array("hub 1", "hub 2", "hub 3", "hub 4", "hub 6", "hub 7", "hub 8", "hub 9", "hub 10", "hub 11", "hub 12", "hub 13", "hub 14", "hub 15", "hub 16", "hub 17", "hub 18", "hub 19", "hub 20", "hub 21")) Last = LastRow(DestSh) sh.Range("A1:F295").Copy DestSh.Cells(Last + 2, "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("A1:C5") 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = .Value 'End With 'sh.Range("A1:C5").Copy 'With DestSh.Cells(Last + 1, "A") ' .PasteSpecial xlPasteValues, , False, False ' .PasteSpecial xlPasteFormats, , False, False ' Application.CutCopyMode = False 'End With DestSh.Cells(Last + 2, "C").Value = sh.Name 'This will copy the sheet name in the D column if you want 'End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Master already exist" End If End Sub -- greengrass ------------------------------------------------------------------------ greengrass's Profile: http://www.excelforum.com/member.php...o&userid=23119 View this thread: http://www.excelforum.com/showthread...hreadid=542694 |
VBA Help on Not Copying Specific Worksheets
I can't see any highlighted text. One thing I noticed when I glanced at this
is the commented line, that checks hub: 'If Left(sh.Name, 4) = "hub" Then This would never be true. You would probably either want to change "hub" to "hub " or change 4 to 3. -- Kevin Vaughn "greengrass" wrote: Hi, In the following function below I am trying to modify Ron de Bruin function for merge cells from all or some worksheets and am running into problems with the entry: For Each sh In Sheets(Array("Sheet1", Sheet2" etc.). I have 24 tabs that can be used for data entry and 2 reserved worksheets for instructions and other macro buttons. You see that I tried a couple of options that are commented out. The error message is a runtime error code 9 and hilites the code in yellow below. Could someone please assist in educating me on the correct way or other options available? Thanks in advance 'Copy a range of each sheet 'This example use the function LastRow Sub Test1() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long On Error Resume Next If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then On Error GoTo 0 Application.ScreenUpdating = False Set DestSh = ThisWorkbook.Worksheets.Add DestSh.Name = "Master" 'For Each sh In ThisWorkbook.Worksheets 'If sh.Name < DestSh.Name Then 'If Left(sh.Name, 4) = "hub" Then For Each sh In Sheets(Array("hub 1", "hub 2", "hub 3", "hub 4", "hub 6", "hub 7", "hub 8", "hub 9", "hub 10", "hub 11", "hub 12", "hub 13", "hub 14", "hub 15", "hub 16", "hub 17", "hub 18", "hub 19", "hub 20", "hub 21")) Last = LastRow(DestSh) sh.Range("A1:F295").Copy DestSh.Cells(Last + 2, "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("A1:C5") 'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ '.Columns.Count).Value = .Value 'End With 'sh.Range("A1:C5").Copy 'With DestSh.Cells(Last + 1, "A") ' .PasteSpecial xlPasteValues, , False, False ' .PasteSpecial xlPasteFormats, , False, False ' Application.CutCopyMode = False 'End With DestSh.Cells(Last + 2, "C").Value = sh.Name 'This will copy the sheet name in the D column if you want 'End If Next DestSh.Cells(1).Select Application.ScreenUpdating = True Else MsgBox "The sheet Master already exist" End If End Sub -- greengrass ------------------------------------------------------------------------ greengrass's Profile: http://www.excelforum.com/member.php...o&userid=23119 View this thread: http://www.excelforum.com/showthread...hreadid=542694 |
VBA Help on Not Copying Specific Worksheets
Ok, now I see the highlighted text. After some experimentation I foun I got the error you indicate if I do not have spreadsheets with th names that you are using in your for loop. For instance, I copied thi to the immediate pane: for each sh in sheets(array("hub 1", "hub 2")):? sh.name: next sh And then I named my sheets hub 1 and hub 2. No problems. Then changed 1 to 3 in the for each line and re-ran it and got the error yo indicated (because I did not have a sheet named hub 3 -- Kevin Vaugh ----------------------------------------------------------------------- Kevin Vaughn's Profile: http://www.excelforum.com/member.php...fo&userid=3485 View this thread: http://www.excelforum.com/showthread.php?threadid=54269 |
VBA Help on Not Copying Specific Worksheets
if you are trying to copy all sheets prefixed "hub" try for each sh in sheets() if left(sh.name,3) ="hub" then your code end if next -- tony h ------------------------------------------------------------------------ tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074 View this thread: http://www.excelforum.com/showthread...hreadid=542694 |
All times are GMT +1. The time now is 10:31 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com