Copying a mulitple Excel file data into a single excel file

[3d4d5c]

Hi Guys,

I have an issue with this vba coding. So the purpose of this file is to import data from a folder of similar excel files (meaning all the excel files have the same structures and format but different values for the input data & different file name) into a single excel file. I managed to source around this code but however when I ran it, nothing happens. Is there anything that I had input wrongly to the code or?
Here's the code

Sub importall()
Dim my_Path As String
Dim File_Name As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False
my_Path = "H:" 'location of the folder'
File_Name = Dir(my_Path & "*.xlsm")
Do While Len(File_Name) <> 0

Workbooks.Open (my_Path & "*.xlsm")

'Rest over here are the copying data from "opened" worksheet to the current worksheet'


Workbooks(Workbooks.Count).Close Savechanges:=False
File_Name = Dir()
Loop
End Sub


Thank you so much guys!!

 

[Wanderer_geologist]

Below

Sub importall()

Dim WB_Name_ext  As String
 dim WB1,wbTemp, wb as workbook
 Set WB1 = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' replacing the import module by a dialog box


    Dim fd As FileDialog
dim cnt as long
Cnt = 0
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
 
                    With fd
                   ' .AllowMultiSelect = False
                    .Filters.Clear
                    .Filters.Add "XLS file", "*.xls; *.xlsx; *.xlsm"
                    '.Show


                        If .Show = -1 Then
                    'Application.WindowState = xlMinimized
                            
 For Each vrtSelectedItem In .SelectedItems
               Cnt = cnt+1
   
                Application.Visible = True
                
                    With Application
                    .EnableEvents = False
                    .ScreenUpdating = False
                    .Calculation = xlCalculationManual
                    End With
    '-----------------------------------------------------------
    ' String capture for WB activation and file naming
                
                WB_Name_ext = Workbooks.Open(vrtSelectedItem).Name ' used to activate WB
                Set wbtemp  = Workbooks(WB_Name_ext)
               wbtemp.Activate



'Rest over here are the copying data from "opened" worksheet to the current worksheet' 




 '---------------
 ' End of loop filling
' below a small loop to close all the WB open
                  For Each wb In Workbooks
                     If Not (wb Is WB1) Then wb.Close savechanges:=False
                  Next
'it can be replaced by
' wbtemp.close savechanges:=False



          Next vrtSelectedItem
          
        If Cnt = 0 Then _
                MsgBox "No files were found...", vbExclamation
        End If
    
    End With
    Set fd = Nothing

    With Application
        .EnableEvents = true
        .ScreenUpdating = true
        .Calculation = xlCalculationautomatic
     End With


End Sub

 

[3d4d5c]

Below

Sub importall()

Dim WB_Name_ext  As String
 dim WB1,wbTemp, wb as workbook
 Set WB1 = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' replacing the import module by a dialog box


    Dim fd As FileDialog
dim cnt as long
Cnt = 0
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
 
                    With fd
                   ' .AllowMultiSelect = False
                    .Filters.Clear
                    .Filters.Add "XLS file", "*.xls; *.xlsx; *.xlsm"
                    '.Show


                        If .Show = -1 Then
                    'Application.WindowState = xlMinimized
                            
 For Each vrtSelectedItem In .SelectedItems
               Cnt = cnt+1
   
                Application.Visible = True
                
                    With Application
                    .EnableEvents = False
                    .ScreenUpdating = False
                    .Calculation = xlCalculationManual
                    End With
    '-----------------------------------------------------------
    ' String capture for WB activation and file naming
                
                WB_Name_ext = Workbooks.Open(vrtSelectedItem).Name ' used to activate WB
                Set wbtemp  = Workbooks(WB_Name_ext)
               wbtemp.Activate



'Rest over here are the copying data from "opened" worksheet to the current worksheet' 




 '---------------
 ' End of loop filling
' below a small loop to close all the WB open
                  For Each wb In Workbooks
                     If Not (wb Is WB1) Then wb.Close savechanges:=False
                  Next
'it can be replaced by
' wbtemp.close savechanges:=False



          Next vrtSelectedItem
          
        If Cnt = 0 Then _
                MsgBox "No files were found...", vbExclamation
        End If
    
    End With
    Set fd = Nothing

    With Application
        .EnableEvents = true
        .ScreenUpdating = true
        .Calculation = xlCalculationautomatic
     End With


End Sub

OMG Thank you so much for the code!! The code works and I will read through the code to see how it functions. Thank you so much!! Really appreciate it!

 

[Wanderer_geologist]

You welcome. I often had to deal with multiple file source so those stay in my toolbox.