Macro to copy all visiable tabs except two from one document to another.

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,679
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,

Ok a bit different this one I think,

I have two documents,

One is Called "Master"
the other is called "Team"

now master holds lots of tabs, some are hidden and if this is the case I want then ignored.

one is called "welcome" and is visible but again to be ignored
one is "Control" this can be visible or hidden but if visible is to be ignored.

then there's all the others this will be about 4-6 tabs and will have different names every time but will be in an order I want to keep.

so what I want to do is copy the other visible tabs from "Master" and put them into "Team" in the same order,
and in "Team" tab "control" column AA list the names of all the tabs added.
In Team the only visible tab will be "Welcome" so all tabs should be added after "Welcome"

and that's it.

please help, been struggling with this all day.
thanks

Tony
 
Last edited:

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub ExportShts2()
   
   Dim Cnt As Long
   Dim Ws As Worksheet
   Dim Ary() As Variant
   Dim Mwbk As Workbook
   Dim Twbk As Workbook
   
   Set Mwbk = Workbooks("Master.xlsm")
   Set Twbk = Workbooks("Team.xlsm")
   
   For Each Ws In Mwbk.Worksheets
      If Ws.Visible And Not Ws.Name = "welcome" And Not Ws.Name = "Control" Then
         Cnt = Cnt + 1
         ReDim Preserve Ary(1 To Cnt)
         Ary(Cnt) = Ws.Name
      End If
   Next Ws
   Twbk.Sheets("Control").Range("AA1").Resize(Cnt).Value = Application.Transpose(Ary)
   Sheets(Ary).Copy after:=Twbk.Sheets(Twbk.Sheets.Count)
   
End Sub
 
Last edited:

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
This assumes the code is located in workbook Master.
Change the name Team.xlsx in the code to the exact name (including extension) of the destination workbook.

Code:
[color=darkblue]Sub[/color] Copy_Tabs()
    
    [color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet, arrSheets [color=darkblue]As[/color] [color=darkblue]Variant[/color], i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]ReDim[/color] arrSheets(1 [color=darkblue]To[/color] Sheets.Count)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] ws [color=darkblue]In[/color] ThisWorkbook.Worksheets
        [color=darkblue]If[/color] ws.Visible = xlSheetVisible [color=darkblue]Then[/color]
            [color=darkblue]If[/color] LCase(ws.Name) <> "control" And LCase(ws.Name) <> "welcome" [color=darkblue]Then[/color]
                i = i + 1
                arrSheets(i) = ws.Name
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] ws
    [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] arrSheets(1 [color=darkblue]To[/color] i)
    
    [color=darkblue]With[/color] Workbooks([B]"Team.xlsx"[/B])
        ThisWorkbook.Sheets(arrSheets).Copy After:=.Sheets("Welcome")
        .Sheets("control").Range("AA" & Rows.Count).End(xlUp).Offset(1).Resize(i).Value = _
            Application.Transpose(arrSheets)
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    MsgBox i & " sheets copied.", vbInformation, "Copy Sheets Complete."
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,679
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Thanks AlphaFrog and Fluff,

Both very helpful and do what I need so a big thanks you

Tony :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,123,400
Messages
5,601,467
Members
414,452
Latest member
Dannysamworth

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