Macro to Open File using Wilcard Character

[howard]

I hsve tried to write code to open a file in C:\Sales Reports by month" using a wilcard characterso to make it easier to select a file to open and copy the data for eg BR1 Sales Report Oct 2022.xlsm

I get a run time error 10 "This array is fixed or temorarily locked" and the code below is highlighted

  A = .SelectedItems(1)

See full code below

It would be appreciated if someone could amend my code

 Sub Open_Workbook()
ChDir ("C:\Sales Reports by month")
A:
Dim A     As Variant
Dim LR As Long
     A = Application.GetOpenFilename(MultiSelect:=True)
    If TypeName(A) = "Boolean" Then Exit Sub
    
    Dim file As Variant
    
    Application.ScreenUpdating = False
   For Each file In A
        With Workbooks.Open(file)
 With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Open"
        With .Filters
            .Clear
            .Add "Excel Files", "*.xlsm"
        End With
        .InitialFileName = "*BR1*.xlsm"
        .Title = "Select File"
         If .Show <> -1 Then Exit Sub
        A = .SelectedItems(1)
    End With
     
       With Sheets(2)
            .UsedRange.Copy _
                Destination:=ThisWorkbook.Sheets("Imported Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
                  End With
           .Close SaveChanges:=False
         
        End With
   
    
 Next

 Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

I'm not quite sure why you have 2 times the instruction to open files, but try the following:

Sub Open_Workbook()
  Dim xfile As Variant
  Dim wb2 As Workbook
  
  Application.ScreenUpdating = False
  
  ChDir ("C:\Sales Reports by month")
  With Application.FileDialog(msoFileDialogFilePicker)
    .ButtonName = "Open"
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsm"
    .InitialFileName = "*BR1*.xlsm"
    .Title = "Select File"
    If .Show <> -1 Then Exit Sub
    For Each xfile In .SelectedItems
      Set wb2 = Workbooks.Open(xfile)
      wb2.Sheets(2).UsedRange.Copy _
        ThisWorkbook.Sheets("Imported Data").Range("A" & Rows.Count).End(xlUp).Offset(1)
      wb2.Close False
    Next
  End With
  
  Application.ScreenUpdating = True
End Sub

 

[howard]

Many Thanks Dante


Your code works perfectly