VBA code to copy specific tab from different workbooks to a new workbook

[nasin123]

Hey Guys,

I am new to this forum. and need help - I am trying to figure out a VBA code which we can use to copy specific tabs ( with a specific name) from different workbooks to a new workbook.

EG : In below sample file, We have Tabs for regions and tabs for branches and i have multiple files like these on my system. So in this case, if we only need to copy the regional tabs ONLY (and that too from multiple work books like these) to a new workbook. Please note that i need to pull such tabs from multiple excels ( which i don't want to open up) to a new excel.

for sample , lets assume all these files ( from where we need to pull these tabs) are saved in this location on my system : C:\Users\XXXX\Documents

Any help on this will be much appreciated.

Thank you!

 

[rondeondo]

Hi Nasin

Below is a variant of a macro I wrote for combining all of the contents of all of the tabs of all of the files in a folder into one tab in one file.
You may need to run it once per region or tweek it a bit to keep the regions separated, I wasn't clear if that was your desired outcome. This will be a start for you.

Sub ConcatenateSheets()
'Purpose: Copy the contents of all xls and xlsx files in a folder into one xls or xlsx file.
'Selected tab names
'Process: Requests a folder from the user. (Source Folder)
'       Requests an excel file from the user (Destination File)
'       systematically goes through each sheet in each excel file in the source folder copying contents to destination file
'
'
'
'
' Path - modify as needed but keep trailing backslash


  Dim sPath As String
  Dim sFile As String
  Dim outFile As String
  Dim wbkSource As Workbook
  Dim wSource As Worksheet
  Dim wTarget As Worksheet
  Dim lMaxSourceRow As Long
  Dim lMaxTargetRow As Long
 
  ' advise user what they are about to do. Hitting No button will stop the macro running

On Error GoTo errorhandler
  If MsgBox("You are about to import all of the excel files in a folder into one excel file." & vbCr & _
            "First select the file to import the data into then a folder with the data to be copied ." & vbCr & _
            "Create a new excel file with right click - new - excel file" & vbCr & _
            "Do you wish to continue?", vbYesNo) = vbNo Then
    Exit Sub
  End If
 
  'outFile = "c:\workingData\testout.xlsx"
  'set default starting path
  sPath = "C:\Users\XXXX\Documents"
  outFile = GetOutputFile(sPath)
    If Len(outFile) < 5 Then
        Exit Sub
    End If
    
  sPath = GetFolder(sPath)
  If Len(sPath) < 5 Then
        Exit Sub
    End If
 
 
  'Confirm what the macro is about to do and folders and file selected. again user can stop by pressing No
  If MsgBox("You have Selected to import files from:" & vbCr & sPath & vbCr & _
            "and you have selected " & outFile & " as your destination file. is this correct? Are you ready to continue?", vbYesNo) = vbNo Then
        Exit Sub
  End If
    
  'set source data set to all files in provided folder
  Set wTarget = Workbooks.Open(outFile).Sheets(1)
  sFile = Dir(sPath & "*.xls*")

    progCount = 0
'process all files in the folder
  Do While Not sFile = ""
    Set wbkSource = Workbooks.Open(fileName:=sPath & sFile, UpdateLinks:=0, AddToMRU:=False)
'               updatelinks Value Meaning
'       0       External references (links) will not be updated when the workbook is opened.
'       3       External references (links) will be updated when the workbook is opened.
    
    SheetCount = 1
    
'process all worksheets in each file
    For Each wSource In wbkSource.Worksheets
        If wSource.Name = "SelectedSheet" Then 'add your sheet names you want here
          ActiveSheet.AutoFilterMode = False
          
          'find the last row in the target file with data.
          lMaxTargetRow = wTarget.cells.SpecialCells(xlLastCell).Row
          'Insert File and sheet name before data
          wTarget.cells(lMaxTargetRow + 1, 1).value = "File: " & wbkSource.Name & " - Sheet: " & wSource.Name
          'copy the source sheet - all used cells into target sheet starting 1 line below last entry
          'This line does copy and paste use if you want to preserve formatting/formulas
          'wSource.UsedRange.Copy wTarget.Cells(lMaxTargetRow + 2, 1)
          
          'This block does copy paste values leaving behind formlas. add in formats if desired
          wSource.UsedRange.Copy
          wTarget.cells(lMaxTargetRow + 2, 1).PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          'end of copy paste values
        End If
        
    Next
    wbkSource.Close SaveChanges:=False
    sFile = Dir
  Loop
  wTarget.Activate
  'find the last row in the target file with data.
  lMaxTargetRow = wTarget.cells.SpecialCells(xlLastCell).Row


  Exit Sub
 
ErrorExit:
    MsgBox "Macro Failed"
    'the ErrorHandler code should only be executed if there is an error
    Exit Sub
errorhandler:
        Debug.Print Err.Number & vbLf & Err.Description
        MsgBox "An error occured during the copy process. " & vbCr & _
        "The last file open was : " & wbkSource.Name & " - Sheet: " & wSource.Name & Err.Number & vbLf & Err.Description
End Sub