Clean up Code

[eddg2011]

So I have this vba code, but it seems pretty redundant. I'm not that good at VBA yet, so could anyone could help me clean this up?

Sub GetSheets()
Dim Path As String
'FolderName gets directory of folder
Dim FolderName As String
 With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   On Error Resume Next
   FolderName = .SelectedItems(1)
   Err.Clear
   On Error GoTo 0
 End With
 MsgBox FolderName & "\"
'Shows directory
 
Path = FolderName & "\"
Dim bFileSaveAs As Boolean
ProjID = InputBox("Project ID:")
'runs through to get all files starting with ProjID
Filename = Dir(Path & ProjID & "*.xl*")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
'Returns PFA reports
Filename = Dir(Path & "PEW_PFA_RPT_" & ProjID & "*.xl*")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
'Returns MTOP
Filename = Dir(Path & "MTOP_" & ProjID & "*.xl*")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
 bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
 If Not bFileSaveAs Then MsgBox "User cancelled", vbCritical
End Sub