Extract and Merge Files

[Auroraaa]

Good Day Everyone.

I am struggling to get my VBA code to work, it keeps giving me an error 450.
The macro is supposed to open a dialogue box and allow the user to select some excel files and then extract some data from those files and paste them into the destination workbook, but after selecting the files I get htis error. Please help.

Sub Labels()
'
' Labels Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Home Team"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Away Team"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Home Goals"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Away Goals"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Home Shots on Goal"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Away Shots on Goal"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Home Shots"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Away Shots"
Columns("A:I").Select
Columns("A:I").EntireColumn.AutoFit

Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim fileDialog As fileDialog
Dim selectedFiles As Variant
Dim filePath As String
Dim nextRow As Long
Dim wbSource As Workbook
Dim homeTeam As String, awayTeam As String
Dim homeScore As String, awayScore As String
Dim matchDate As String
Dim homeShotsOnGoal As String, awayShotsOnGoal As String
Dim homeShots As String, awayShots As String
Dim i As Integer

' Set destination worksheet (active workbook)
Set wsDest = ThisWorkbook.Sheets(1)

' Initialize file dialog for selecting multiple files
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
fileDialog.AllowMultiSelect = True
fileDialog.Filters.Clear
fileDialog.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm"

' Show the dialog and store the selected files
If fileDialog.Show = -1 Then
selectedFiles = fileDialog.SelectedItems
' Check if any files were selected
If Not IsArray(selectedFiles) Then
MsgBox "No files selected. Exiting.", vbExclamation
Exit Sub
End If
Else
MsgBox "No files selected. Exiting.", vbExclamation
Exit Sub
End If

' Loop through each selected file
For i = 1 To UBound(selectedFiles)
filePath = selectedFiles(i)

' Open the source workbook
Set wbSource = Workbooks.Open(filePath)
Set wsSource = wbSource.Sheets(1)

' Find the next available row in the destination sheet
nextRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1

' Extract the match data
matchDate = wsSource.Range("D6").Value & " " & wsSource.Range("E6").Value & " " & wsSource.Range("F6").Value
homeTeam = wsSource.Range("A2").Value & " " & wsSource.Range("B2").Value & " " & wsSource.Range("C2").Value & " " & wsSource.Range("D2").Value
awayTeam = wsSource.Range("F2").Value & " " & wsSource.Range("G2").Value & " " & wsSource.Range("H2").Value & " " & wsSource.Range("I2").Value
homeScore = wsSource.Range("B5").Value & "-" & wsSource.Range("C5").Value
awayScore = wsSource.Range("G5").Value & "-" & wsSource.Range("H5").Value
homeShotsOnGoal = wsSource.Range("C12").Value
awayShotsOnGoal = wsSource.Range("G12").Value
homeShots = wsSource.Range("C14").Value
awayShots = wsSource.Range("G14").Value

' Paste the data into the destination workbook
wsDest.Cells(nextRow, 1).Value = matchDate
wsDest.Cells(nextRow, 2).Value = homeTeam
wsDest.Cells(nextRow, 3).Value = awayTeam
wsDest.Cells(nextRow, 4).Value = homeScore
wsDest.Cells(nextRow, 5).Value = awayScore
wsDest.Cells(nextRow, 6).Value = homeShotsOnGoal
wsDest.Cells(nextRow, 7).Value = awayShotsOnGoal
wsDest.Cells(nextRow, 8).Value = homeShots
wsDest.Cells(nextRow, 9).Value = awayShots

' Close the source workbook without saving
wbSource.Close False
Next i

MsgBox "Data extraction complete!", vbInformation
End Sub

 

[rowebca]

Replace

selectedFiles = fileDialog.SelectedItems

with

Dim m As Integer
m = fileDialog.SelectedItems.Count
If m > 0 Then
        ReDim selectedFiles(1 To m)
        Dim x As Long
        For x = 1 To m
        selectedFiles(x) = fileDialog.SelectedItems(x)
        Next
End If

Regards,
GB