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

[tonywatsonhelp]

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

 

[Fluff]

How about

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

 

[AlphaFrog]

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.

[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]

Thanks AlphaFrog and Fluff,

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

Tony

 

[Fluff]

Glad we could help & thanks for the feedback