Selecting Variable Tabsheets in Different Workbook

[Thomazz]

It has been a while since I needed to ask a question, but here I am again ...

Don't think it's hard, but have been working on this for two days already and it's starting to annoy me. I will explain as good as I can.

I have a workbook, let's call it the source workbook. There is a range of cells (let's say C2 till E2) that all have tabnames from a different workbook in there (these are filled in by the user). Let's use the names Brazil, USA and China as an example.

I want VBA to go to a different workbook ("Actual Data"), select the 3 tabsheets there (Brazil, USA, China) and copy it to a new workbook.

Difficulty might be : the range of cells can be different in length. It might be two cells (C2 till D2) depending on how many cells my user has filled in.

That's my main problem.


What my macro also does, is go to the next row in the source workbook, and do the same thing for the next row (so take a range, for this example C3 till F3, go back to the Actual Data file, copy these 4 tabsheets to a new workbook and so on ...

Anybody that can help me here ? My eternal gratitude.

 

[cooper645]

This should suit your needs, it assumes data is in:

C2 to Variable Column

down to C Variable row, Variable columns

Sub LoopRangeLogically()
'https://www.mrexcel.com/board/threads/selecting-variable-tabsheets-in-different-workbook.1149834/
Dim LRow As Long, LCol As Long
Dim i As Integer, j As Integer

LRow = Cells(Rows.Count, "C").End(xlUp).Row 'Get last row of entries in column C

For i = 2 To LRow 'loop to work throuhg rows 2 to LastRow of data
    LCol = Cells(i, Columns.Count).End(xlToLeft).Column  'Get the last column number of data
        For j = 3 To LCol 'loop to work through columns in current row
            MsgBox Cells(i, j).Value
            'Other code to draw in tabs goes here
        Next j
Next i

End Sub

 

[Thomazz]

That's already correct yes. However, it's the part where I need to actually select those sheets that are selected (so C2 to Variable Column) in other workfile that gives me a headache.

 

[cooper645]

is it always the same different work book? if not where is that workbook name/filepath stored in the master workbook?

 

[Thomazz]

is it always the same different work book? if not where is that workbook name/filepath stored in the master workbook?

I have the file path and name stored in a cell as it's always different (so in the original workbook, let's say at position (1,1) I have the full path name (for example C:\Folder 1\WorkbookData.xls)

 

[cooper645]

Sub LoopRangeLogically()
'https://www.mrexcel.com/board/threads/selecting-variable-tabsheets-in-different-workbook.1149834/
Dim LRow As Long, LCol As Long
Dim i As Integer, j As Integer
Dim TargetFile As Workbook, Master As Workbook
Dim TgtSh As String, fPath As String
Application.ScreenUpdating = False
Set Master = ThisWorkbook

LRow = Master.Sheets("Test").Cells(Rows.Count, "C").End(xlUp).Row 'Get last row of entries in column C

For i = 2 To LRow 'loop to work through rows 2 to LastRow of data
    LCol = Master.Sheets("Test").Cells(i, Columns.Count).End(xlToLeft).Column  'Get the last column number of data
        For j = 3 To LCol 'loop to work through columns in current row
            TgtSh = Master.Sheets("Test").Cells(i, j).Value
            fPath = Master.Sheets("Test").Cells(i, 2).Value 'Assumes target workbook filepath in same row as sheet data column B
            Set TaretFile = Workbooks.Open(fPath)
            Sheets(TgtSh).Copy After:=Master.Sheets(Master.Sheets.Count)
        Next j
        Workbooks.Open (fPath)
        ActiveWorkbook.Close SaveChanges:=False
Next i


Application.ScreenUpdating = True
End Sub

 

[Thomazz]

Sub LoopRangeLogically()
'https://www.mrexcel.com/board/threads/selecting-variable-tabsheets-in-different-workbook.1149834/
Dim LRow As Long, LCol As Long
Dim i As Integer, j As Integer
Dim TargetFile As Workbook, Master As Workbook
Dim TgtSh As String, fPath As String
Application.ScreenUpdating = False
Set Master = ThisWorkbook

LRow = Master.Sheets("Test").Cells(Rows.Count, "C").End(xlUp).Row 'Get last row of entries in column C

For i = 2 To LRow 'loop to work through rows 2 to LastRow of data
    LCol = Master.Sheets("Test").Cells(i, Columns.Count).End(xlToLeft).Column  'Get the last column number of data
        For j = 3 To LCol 'loop to work through columns in current row
            TgtSh = Master.Sheets("Test").Cells(i, j).Value
            fPath = Master.Sheets("Test").Cells(i, 2).Value 'Assumes target workbook filepath in same row as sheet data column B
            Set TaretFile = Workbooks.Open(fPath)
            Sheets(TgtSh).Copy After:=Master.Sheets(Master.Sheets.Count)
        Next j
        Workbooks.Open (fPath)
        ActiveWorkbook.Close SaveChanges:=False
Next i


Application.ScreenUpdating = True
End Sub

I adjusted your code slightly, as it always goes back to the same file. We are almost getting there.

The only problem I have now : it's copying everything from the first row (in my case row 22) behind my original sheet (MasterSheet). However, I need it copied to a completely new workbook and save that new workbook under a different name.

After that, he needs to go to the next line (row 23), go back to my data file and copy these tabsheets to another new workbook.

It means i will have as many new workbooks as I have rows in my first file.

Sub LoopRangeLogically()
'https://www.mrexcel.com/board/threads/selecting-variable-tabsheets-in-different-workbook.1149834/
Dim LRow As Long, LCol As Long
Dim i As Integer, j As Integer
Dim TargetFile As Workbook, Master As Workbook
Dim TgtSh As String, fPath As String
Dim fname As String
Application.ScreenUpdating = False
Set Master = ThisWorkbook

fPath = Workbooks("Mail Test Macro.xlsb").Sheets("List").Cells(7, 2).Value
fname = Workbooks("Mail Test Macro.xlsb").Sheets("List").Cells(6, 2).Value

Workbooks.Open (fPath)

LRow = Master.Sheets("List").Cells(Rows.Count, "E").End(xlUp).Row 'Get last row of entries in column E

For i = 22 To LRow 'loop to work through rows 2 to LastRow of data
    LCol = Master.Sheets("List").Cells(i, Columns.Count).End(xlToLeft).Column  'Get the last column number of data
        For j = 5 To LCol 'loop to work through columns in current row
            TgtSh = Master.Sheets("List").Cells(i, j).Value
            Windows(fname).Activate
            Sheets(TgtSh).Copy After:=Master.Sheets(Master.Sheets.Count)
        Next j

Next i


Application.ScreenUpdating = True
End Sub

 

[cooper645]

I’m out of the office now, if you had supplied all the info you needed the code to do at the beginning it would have been more helpful. I will look into this later when I get a chance.

 

[VBasic2008]

Copy Sheets in One Go

The following will use an array of sheet names to copy the sheets to a new workbook.

Option Explicit

Sub copyTabSheets()
  
    ' Define constants.
  
    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 2
    Const FirstCol As Variant = "C"
    Const wbAddress As String = "A1" ' in the same Worksheet.

    ' Define First Column Range (of sheet names) ('rng').
  
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsName)
  
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, FirstCol).End(xlUp).Row
    If LastRow < FirstRow Then
        Exit Sub
    End If
  
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, FirstCol), _
                         ws.Cells(LastRow, FirstCol))
  
    ' Write sheet names to arrays of Data Array ('Data').
  
    Dim ArraysCount As Long
    ArraysCount = rng.Rows.Count
  
    Dim Data As Variant
    ReDim Data(1 To ArraysCount)
  
    Dim n As Long
    Dim m As Long
  
    ' Note: There can be empty rows ('m'), but not empty columns.
    For n = 1 To ArraysCount
        With rng.Cells(n)
            If .Value <> "" Then
                m = m + 1
                If .Offset(, 1).Value <> "" Then
                    Data(m) = Application.Transpose(Application.Transpose( _
                      .Resize(, .End(xlToRight).Column - .Column + 1).Value))
                Else
                    Data(m) = .Value
                End If
            End If
        End With
    Next n
  
    ' Create workbooks.
  
    ' Note: The worksheets can only be in order as they were before.
    Application.ScreenUpdating = True
    With Workbooks.Open(ws.Range(wbAddress).Value)
        For n = 1 To m
            .Sheets(Data(n)).Copy
            ActiveWorkbook.Saved = True ' To easily close them.
        Next n
        .Close SaveChanges:=False
    End With
    Application.ScreenUpdating = True
  
    ' Inform user.
  
    MsgBox "Workbooks created.", vbInformation, "Success"
  
End Sub

 

[VBasic2008]

Copy Sheets in One Go

The following will use an array of sheet names to copy the sheets to a new workbook.

Option Explicit

Sub copyTabSheets()

    ' Define constants.

    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 2
    Const FirstCol As Variant = "C"
    Const wbAddress As String = "A1" ' in the same Worksheet.

    ' Define First Column Range (of sheet names) ('rng').

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsName)

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, FirstCol).End(xlUp).Row
    If LastRow < FirstRow Then
        Exit Sub
    End If

    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, FirstCol), _
                         ws.Cells(LastRow, FirstCol))

    ' Write sheet names to arrays of Data Array ('Data').

    Dim ArraysCount As Long
    ArraysCount = rng.Rows.Count

    Dim Data As Variant
    ReDim Data(1 To ArraysCount)

    Dim n As Long
    Dim m As Long

    ' Note: There can be empty rows ('m'), but not empty columns.
    For n = 1 To ArraysCount
        With rng.Cells(n)
            If .Value <> "" Then
                m = m + 1
                If .Offset(, 1).Value <> "" Then
                    Data(m) = Application.Transpose(Application.Transpose( _
                      .Resize(, .End(xlToRight).Column - .Column + 1).Value))
                Else
                    Data(m) = .Value
                End If
            End If
        End With
    Next n

    ' Create workbooks.

    ' Note: The worksheets can only be in order as they were before.
    Application.ScreenUpdating = True
    With Workbooks.Open(ws.Range(wbAddress).Value)
        For n = 1 To m
            .Sheets(Data(n)).Copy
            ActiveWorkbook.Saved = True ' To easily close them.
        Next n
        .Close SaveChanges:=False
    End With
    Application.ScreenUpdating = True

    ' Inform user.

    MsgBox "Workbooks created.", vbInformation, "Success"

End Sub

Here's a bonus if you get tired of closing workbooks:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Closes all workbooks except this one (ThisWorkbook).           '
' Returns:      The number of closed workbooks.                                '
' Remarks:      Caution: The changes on those other workbooks will be lost.    '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function closeWorkbooks(Optional closeHidden As Boolean = False) As Long
    Dim wb As Workbook, i As Long
    Application.ScreenUpdating = False
    For Each wb In Workbooks
        If Not wb Is ThisWorkbook Then
            If Not closeHidden Then
                If Windows(wb.Name).Visible Then
                    wb.Close False
                    closeWorkbooks = closeWorkbooks + 1
                End If
            Else
                wb.Close False
                closeWorkbooks = closeWorkbooks + 1
            End If
        End If
    Next wb
    Application.ScreenUpdating = True
    Exit Function
End Function

Sub USEcloseWorkbooks()
    closeWorkbooks
End Sub
'Or
Sub USEcloseWorkbooks2()
    Dim num As Long
    num = closeWorkbooks
    MsgBox "Closed " & num & " workbooks."
End Sub