Extract files from a specific location and add them as sheets to existing Excel file using macro button

[Mazurofgod]

Hey Smart people,
I am looking for a VBA code which can be triggered and used to extract files from a specific location for example as 'Inputs' and be saved to an existing workbook where I have my pivot tables which use the data from respective sheets in the workbook where it clears the data from the existing respective sheets within a range as there are some formulas I don't want to delete or redo. Ideally, I have specific sheets in the workbook which have the respective file data saved. If the VBA code works with the same I would much appreciate it. The version of Excel is 2016. Any alternative ideas are also welcome.

 

[DJFANDANGO]

Hi Mazurofgod,

Try this, remember to set the code to your 'local' files/sheets etc.

Sub ImportFilesAndUpdateSheets()
Dim ws As Worksheet
Dim sourceWB As Workbook
Dim targetWB As Workbook
Dim filePath As String
Dim fileDialog As FileDialog
Dim lastRow As Long
Dim destSheet As Worksheet
Dim sourceSheet As Worksheet
Dim rng As Range
Dim importFolder As String
Dim fileName As String
Dim sheetName As String

' Set the workbook with the pivot tables
Set targetWB = ThisWorkbook

' Set the folder location from which to import files (Update this folder location as needed)
importFolder = "C:\path\to\your\Inputs\Folder" ' Change this to your input folder path

' Use FileDialog to choose files
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
With fileDialog
.AllowMultiSelect = True
.Title = "Select the files to import"
.Filters.Clear
.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm"
If .Show = -1 Then
' Files selected
For i = 1 To .SelectedItems.Count
fileName = .SelectedItems(i)
' Open the selected source file
Set sourceWB = Workbooks.Open(fileName)

' Loop through each sheet in the source workbook that needs importing
For Each sourceSheet In sourceWB.Sheets
' Identify the corresponding sheet in the target workbook
On Error Resume Next
Set destSheet = targetWB.Sheets(sourceSheet.Name)
On Error GoTo 0

If Not destSheet Is Nothing Then
' Clear the data from the destination sheet (keeping formulas intact)
With destSheet
Set rng = .Range("A2:Z" & .Cells(.Rows.Count, "A").End(xlUp).Row)
rng.ClearContents ' Clears data but keeps formulas
End With

' Copy data from the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
sourceSheet.Range("A2:Z" & lastRow).Copy destSheet.Range("A2")
End If
End If
Next sourceSheet

' Close the source file without saving
sourceWB.Close SaveChanges:=False
Next i
Else
MsgBox "No files selected. Process aborted.", vbExclamation
Exit Sub
End If
End With

' Refresh all pivot tables in the workbook after importing the data
For Each ws In targetWB.Sheets
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws

MsgBox "Data imported and pivot tables refreshed successfully!", vbInformation
End Sub

 

[Mazurofgod]

Thank you @DJFANDANGO will give it a go now