• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 337
  • Last Modified:

Copy data from every tab in a workbook to a different workbook

Is there a quick way [using VBA] to copy the data from every tab I have in my existing workbook [except those named Sheet1, Sheet2, Sheet3 and Sheet4] to another workbook and include the Tab names. I have 40 tabs in the workbook.

Here's hoping!

Thanks
0
Jagwarman
Asked:
Jagwarman
  • 11
  • 7
1 Solution
 
Rgonzo1971Commented:
Hi,

Pls try

Sub Macro()

Set DestWbk = Workbooks("YourFile.xlsx")
For Each ws In ActiveWorkbook.Sheets
    If Not (ws.Name Like "Sheet[1-4]") Then
        ws.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)
    End If
Next
End Sub

Open in new window

Regards
0
 
JagwarmanAuthor Commented:
Hi Rgonzo1971

it tells me Variable not defined.

Also, I was hoping for sheets 1-4 it would be written so that I can amend if for instance I want to include the sheet named [i.e. Dashboard or menu etc]

Will I be able to change "Sheet[1-4]" to include the above if I need to?

Thanks for your help with this

Kind regards
0
 
JagwarmanAuthor Commented:
sorry it tells me Variable not defined here

Set DestWbk = Workbooks
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Rgonzo1971Commented:
Hi,

Have you changed YourFile

at line 2 insert

Dim DestWbk as Workbook

Regards
0
 
JagwarmanAuthor Commented:
I have added. [Is this correct]

Dim DestWbk As Workbook
Dim ws As Worksheet

But now I have another question: is ("YourFile.xlsx") the file with all the tabs on or the new workbook where they will be copied to.

I am not sure I can see how the code goes from existing workbook to new workbook.

Sorry to be a dumb head.
0
 
Rgonzo1971Commented:
Hi,

pls try

YourFile is the destination File

Sub Macro()
Dim DestWbk As Workbook
Set DestWbk = Workbooks("YourFile.xlsm")
For Each ws In ActiveWorkbook.Sheets
    If Not ((ws.Name Like "Sheet[1-4]") Or _
            (ws.Name = "Dashboard") Or _
            (ws.Name = "Menu")) Then
        ws.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)
    End If
Next
End Sub

Open in new window

Regards
0
 
JagwarmanAuthor Commented:
really sorry but if ("YourFile.xlsx") is the destination file I presume I have to open it. So I did that.

The code is in my file with the 40 tabs so I guess it should then copy to "yourfile.xlsx"

but nothing is being copied. It appears to miss out the code

ws.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

it is going from

If Not ((ws.Name Like "Sheet[1-4]") Or _
            (ws.Name = "Dashboard") Or _
            (ws.Name = "Menu")) Then

to End IF

hope this makes sense.

Thanks
0
 
Rgonzo1971Commented:
Hi

the code should be in the source workbook
Sub Macro()
Dim DestWbk As Workbook
Set DestWbk = Workbooks("YourFile.xlsm")
For Each ws In ThisWorkbook.Sheets
    If Not ((ws.Name Like "Sheet[1-4]") Or _
            (ws.Name = "Dashboard") Or _
            (ws.Name = "Menu")) Then
        ws.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)
    End If
Next
End Sub 

Open in new window


Regards
0
 
JagwarmanAuthor Commented:
unfortuantely I cannot get this to work

but thanks for trying
0
 
JagwarmanAuthor Commented:
I have tried this on my personal PC and it works so I will try again tomorrow.

Regards
0
 
JagwarmanAuthor Commented:
Rgonzo1971

Hope you are still here, and thank you for your patience.

As I mentioned previously, it worked fine on my personal PC but at work ........

it falls over at .... ws.Copy After:=DestWbk.Sheets(DestWbk.Sheets.Count)

with

method copy of object _worksheet failed

When I hover over the code I can see it is finding the Workbook and identifying how many tabs are in the Wbk.

Any Ideas?

Thanks
0
 
Rgonzo1971Commented:
Hi,

In which File is the code?

Regards
0
 
JagwarmanAuthor Commented:
the file with the 40 Tabs
0
 
JagwarmanAuthor Commented:
I found this in a Google search and it also falls over

at WkSht.Copy After:=NewBook.Sheets(NewBook.Sheets.Count)


Application.ScreenUpdating = False
    Dim ThisBook As Workbook
    Dim WkSht As Worksheet, NewBook As Workbook
    Set ThisBook = ThisWorkbook
    Set NewBook = Workbooks.Add(xlWBATWorksheet)
    For Each WkSht In ThisBook.Worksheets
        Select Case WkSht.Name
        Case "DataCapture", "INFORMATION", "A_ISPACEMONTH", "A_ISPACEYEAR"
             'these are the sheets names which shouldn't be copied
        Case Else
            WkSht.Copy After:=NewBook.Sheets(NewBook.Sheets.Count)
        End Select
        Application.CutCopyMode = False
    Next WkSht
    Application.DisplayAlerts = False
    'Worksheets("Sheet1").Delete
    'Worksheets("Sheet1 (2)").Name = "Sheet1"
    NewBook.SaveAs Filename:="TestItOut.xls"


But if I skip over that row it works fine. It creates a new workbook and saves it.

does this give you any clues?
0
 
Rgonzo1971Commented:
Hi,

Are you trying to copy a sheet which is with Visible = xlSheetVeryHidden?


Regards
0
 
JagwarmanAuthor Commented:
I do have hidden sheets but I don't want those copied

Regards
0
 
Rgonzo1971Commented:
So
let's try

Sub Macro1()
Application.ScreenUpdating = False
    Dim ThisBook As Workbook
    Dim WkSht As Worksheet, NewBook As Workbook
    Set ThisBook = ThisWorkbook
    Set NewBook = Workbooks.Add(xlWBATWorksheet)
    For Each WkSht In ThisBook.Sheets
        If WkSht.Visible <> xlSheetVeryHidden Then
            Select Case WkSht.Name
            Case "DataCapture", "INFORMATION", "A_ISPACEMONTH", "A_ISPACEYEAR"
                 'these are the sheets names which shouldn't be copied
            Case Else
                WkSht.Copy After:=NewBook.Sheets(NewBook.Sheets.Count)
            End Select
            Application.CutCopyMode = False
        End If
    Next WkSht
    Application.DisplayAlerts = False
    'Worksheets("Sheet1").Delete
    'Worksheets("Sheet1 (2)").Name = "Sheet1"
    NewBook.SaveAs Filename:="TestItOut.xls"

 End Sub

Open in new window

0
 
JagwarmanAuthor Commented:
Rgonzo1971

thank you for helping me with this, brilliant, it now does exactly what I need it to do.

Have a good Xmas

Regards
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 11
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now