Dim bok As Workbook 'книга в которой собираем данные
  dim bres as Workbook 
  dim i as integer 'перебор адресов книг


  Set bok = Workbooks.Add

  for i= 0  to listbox.items.count- 1 
    Set bres = Workbooks.Open(listbox.items(i))

      bres.ActiveSheet.Range("A:H").Copy
      bok.Worksheets(i+ 1 ).Range("A1").PasteSpecial Paste:=xlPasteValues

  next i

OriWB = Range("A1").CurrentRegion

Set rgTarget = WBmacros.Resize( 1 ,  1 ).Offset(WBmacros.Rows.Counts)

Private Sub CommandButton1_Click()
Dim iTempFileName As String 'имя поочерёдно открываемого файла
  Dim WBmacros As Workbook 'Файл для вставки данных (файл с этим макросом)
  Dim rgTarget As Range 'Ячека для вставки скопированных данных
  Dim OriWB As Workbook


Const DirLoc As String = "C:\Обработка филиалов СИА\"
iTempFileName = Dir(DirLoc & "*.xls")

Set OriWB = Workbooks.Open(Filename:=DirLoc & iTempFileName, ReadOnly:=True)

    OriWB.Worksheets("Лист 1").Range("A1:P73").Select
    Selection.Copy
    ActiveSheet.Range("A1").Select
    ActiveSheet.Paste
End Sub

  Dim cl As Integer   'номер последнего столбца с данными
  Dim rw As Integer  'номер последней строки с данными
  cl = ActiveSheet.Cells.SpecialCells(xlLastCell).Column   'читаем номер последнего столбца с данными на текущем листе
  rw = ActiveSheet.Cells.SpecialCells(xlLastCell).Row  'читаем номер последней строки с данными на текущем листе
  With ActiveSheet
    .Range(.Cells( 1 ,  1 ), .Cells(rw, cl)).Select   'выделяем диапазон с ячейки A1 по последнюю диапазона данных
  End With