Copying worksheets from one workbook to another based on a list

ath

New Member
Joined
Dec 10, 2020
Messages
8
Hello,

I am trying to get some code working where I can copy worksheets from one workbook into another based on a list. Here is the code i have put together so far:

Dim Sht As Worksheet
Dim sheet_names As Variant
Dim destWB As Workbook
Set destWB = ThisWorkbook

sheet_names = OpenBook.Sheets("CaseList").Range("C2:C2000").Value

For Each Sht In OpenBook.Sheets

If Not IsError(Application.Match(Sht.Name, sheet_names, 0)) Then

Sht.Copy After:=destWB.Sheets(Sheets.Count)

End If

Next Sht

When i run the code, i get a runtime error 424 message. Any help would be appreciated.

Thanks
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I think I would do it like this, Assuming OpenBook has been declared and initialized elsewhere in the code.

Rich (BB code):
Dim Sht As Worksheet
Dim sheet_names As Range
Dim destWB As Workbook
Set destWB = ThisWorkbook
Set sheet_names = OpenBook.Sheets("CaseList").Range("C2:C2000")
For Each Sht In OpenBook.Sheets
    If Application.CountIf(sheet_names, Sht.Name) = 0 Then 'This might need tweaking  to change from = to >
        Sht.Copy After:=destWB.Sheets(Sheets.Count)
   End If
Next Sht
 

ath

New Member
Joined
Dec 10, 2020
Messages
8
thanks JLGWhiz for responding. this is what i have now, based on your recommendations and i tried it with = and > and i am getting a runtime error 9 message:

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim destWB As Workbook
Set destWB = ThisWorkbook
Dim Sht As Worksheet
Dim sheet_names As Range

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)

End If

Set sheet_names = OpenBook.Sheets("CaseList").Range("C2:C2000")

For Each Sht In OpenBook.Sheets

If Application.CountIf(sheet_names, Sht.Name) > 0 Then 'This might need tweaking to change from = to >

Sht.Copy After:=destWB.Sheets(Sheets.Count)

End If

Next Sht
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Well, the equal and greater than symbols have nothing to do with the 'Subscript out of Range' message, That error occurs when the code is telling the compiler to perform an execution on an object that does not exist in the file the code points to. It can be misspelled file or sheet names, spaces that are leading, trailing or added between strings in a name, and ommission of spaces between strings in a name. In simple terms, what the code tells the compiler to look for must match what is on the worksheet where it is told to look.

I mentioned before that I did not see any reference to 'OpenBook' and assumed you had it defined elsewhere in the code. If you do not have that variable declared and 'Set' prior to a statement telling it to execute on that variable, then it will give you the Error 9.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

This ran without error for me in a test set up.

VBA Code:
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim destWB As Workbook
Set destWB = ThisWorkbook
Dim Sht As Worksheet
Dim sheet_names As Range
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Workbooks.Open(FileToOpen)
    Else
        MsgBox "FileToOpen failed"
        Exit Sub
    End If
Set sheet_names = OpenBook.Sheets("CaseList").Range("C2:C2000")
For Each Sht In OpenBook.Sheets
    If Application.CountIf(sheet_names, Sht.Name) > 0 Then 'This might need tweaking to change from = to >
        Sht.Copy After:=destWB.Sheets(Sheets.Count)
    End If
Next Sht
Regarding the = and > symbols, It depends on what condition you want. I don't know what the names in column C of sheet "CaseList" represents. So if you want to use the list to prevent duplication the = 0 would apply, but if you are testing for applicability of sorts then the > 0 would apply.
 

ath

New Member
Joined
Dec 10, 2020
Messages
8
Thanks for the reply. In my second post, i included everything how i am running the code, including setting openbook.

If i take out Sht.Copy After:=destWB.Sheets(Sheets.Count) and replace it with Sht.Protect, the code will loop through all worksheets in the openbook and protects them. that leads me to believe that it is in Sht.Copy After:=destWB.Sheets(Sheets.Count). My guess is that it doesn't like the destWB declaration. I've tried ThisWorkbook as well and get the same error.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

The easy way to find out why you are getting an error is to click the 'Debug' button and it will show you the line of code where execution failed.
 

ath

New Member
Joined
Dec 10, 2020
Messages
8
When i run debug, it says the this is the line of code where execution failed is: Sht.Copy After:=destWB.Sheets(Sheets.Count)

I took the code you tested and ran it in my workbooks and still get the runtime 9 error. I set up two test workbooks, one to run it from and the other to copy from and i still get the runtime error 9.

I really can't see what is going wrong. Thanks for your help.
 

ath

New Member
Joined
Dec 10, 2020
Messages
8
I was able to get this to work. Main thing was adding destWB to (Sheets.Count) cause otherwise it was counting the sheets in the wrong workbook. Thanks for all of your help.

VBA Code:
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim destWB As Workbook
Set destWB = ThisWorkbook
Dim Sht As Worksheet
Dim sheet_names As Range

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)

Set sheet_names = OpenBook.Sheets("CaseList").Range("C2:C2000")

End If

'loop through worksheets

For Each Sht In OpenBook.Sheets

If Not IsError(Application.Match(Sht.Name, sheet_names, 0)) Then

Sht.Copy After:=destWB.Sheets(destWB.Sheets.Count)

End If

Next Sht
 
Solution

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
glad you figured it out. I was running the code from the destination workbook, so the default did not throw the error. So it depends on where the code is run from and if that is the active workbook. Any object that is not qualified with its parent object, reverts to the active sheet. So we have to be sure all objects are properly qualified in the code. You can check your own code as the solution.
Regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,122,437
Messages
5,596,113
Members
414,043
Latest member
thomas Stein

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top