Macro Excel import single sheet from various files

Question

I have a macro excel file that does some clean up on cells and I need to import a single sheet from various files on the same folder. For example I need the sheet1 from all the excel files located on the same folder as my macro file. I have a code to do that manually but I need to be able to do it automatically either by selecting the files or running another macro to select them no matter the amount of files on the folder.

Sub Carga_Masiva()

Dim fName As String, wb As Workbook
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
    For Each sh In wb.Sheets
        If Application.CountA(sh.Cells) > 0 Then
            sh.Copy Before:=ThisWorkbook.Sheets(1)
            Exit For
        End If
    Next
    wb.Close False
    
End Sub

You can use `Dir()` to loop over all files in a folder, and `ThisWorkbook.Path` will give you the location of the folder where the file with the currently-running VBA is saved. For examples see: https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba — Tim Williams, Aug 31 '21 at 21:14

score 1 · Accepted Answer · answered Aug 31 '21 at 22:59

I'd prompt user for a folder and then iterate over each file except the one with your macro.

To prompt for a folder use this solution (in my code as optional variant): link

Complete code below:

Sub Carga_Masiva()

Dim sh As Worksheet
Dim fName As String, wb As Workbook
fName = Application.GetOpenfnamename("Excel fnames (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)

For Each sh In wb.Sheets
    If Application.CountA(sh.Cells) > 0 Then
        sh.Copy Before:=ThisWorkbook.Sheets(1)
        Exit For
    End If
Next
wb.Close False
    
End Sub

Sub CopyToThisWorkbook()
    Dim wbMacro, wb As Workbook
    Set wbMacro = ThisWorkbook
    Dim sh As Worksheet
    Dim folderPath, fName, tabName As String
    
    folderPath = wbMacro.Path & Application.PathSeparator
    
    'Prompt variant
    'folderPath = GetFolder & Application.PathSeparator
    fName = Dir(PathName:=folderPath)
    
    Do
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        'Open all files except the one with macro
        If fName <> wbMacro.Name Then
            'Your code
            Set wb = Workbooks.Open(wbMacro.Path & "\" & fName)
            For Each sh In wb.Sheets
                If Application.CountA(sh.Cells) > 0 Then
                    tabName = sh.Name & "_" & Right(wb.Name, 10) 'Optional - rename Worksheet to be copied
                    sh.Name = tabName 'Optional
                    sh.Copy Before:=wbMacro.Sheets(1) 
                Exit For
                End If
            Next sh
            wb.Close SaveChanges:=False
        End If
       
        fName = Dir
    Loop Until fName = ""
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Function GetFolder() As String 'Optional variant
    Dim fldr As fnameDialog
    Dim sItem As String
    Set fldr = Application.fnameDialog(msofnameDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialfnameName = Application.DefaultfnamePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Macro Excel import single sheet from various files

1 Answers1