Вот мой код  
 
Option Explicit  
 
Private Sub CommandButton1_Click()  
Dim FD As FileDialog  
Dim iFileName As String  
Dim NewWB As Workbook  
Dim ActSht As Worksheet  
 
Application.DisplayAlerts = False  
     
  On Error Resume Next  
   Sheets("Данные из журнала").Delete ' удаление листа с устаревшими данными  
     
   Set FD = Application.FileDialog(msoFileDialogFilePicker)  
   With FD  
       .AllowMultiSelect = False  
       With .Filters  
           .Clear  
           .Add "Файлы Excel 97-2003", "*.xls*"  
       End With  
         
       If .Show = False Then Exit Sub Else iFileName = .SelectedItems(1)  
         
   End With  
   Set ActSht = ActiveSheet  
   Set NewWB = Workbooks.Open(Filename:=iFileName, UpdateLinks:=0, ReadOnly:=1)  
   Me.TextBox1.Text = iFileName  
       
   Cells.Copy  
             
   Windows("Общий файл_23.xlsm").Activate  
   Sheets.Add After:=Sheets(Sheets.Count)  
     
   ActiveSheet.Paste  
     
   ActiveSheet.Name = "Данные из журнала"  
     
   NewWB.Close False 'закрыть открытый файл  
     
  Application.DisplayAlerts = True  
     
  Unload Me  
     
  ' выравнивание значений в ячейках по высоте  
  Cells.VerticalAlignment = xlCenter  
  Cells.Validation.Delete  
     
  Range("A2").Select  
     
End Sub