Sub Podgotovka1()
      Dim x As String
      Dim x1 As Long
      Dim wb As Workbook
      Dim i As Long
      i = 4
      Ch_Dir = "C:\XLS_FILES\"
      Application.ScreenUpdating = False
      x1 = 1
      x = "*.xls"
      nmfile = Dir(Ch_Dir & x)
      pthname = Ch_Dir + nmfile
      MsgBox (pthname)

      Do While nmfile <> ""
          nmfile = Dir()
          pthname = Ch_Dir + nmfile
          x1 = x1 + 1
          If nmfile <> "" Then
          MsgBox (pthname)
          Set wb = Workbooks.Open(pthname)
          ThisWorkbook.Worksheets(1).Range("a" & x1 + i).Value = x1
          ThisWorkbook.Worksheets(1).Range("b" & x1 + i).Value = Range("b11").Value
          ThisWorkbook.Worksheets(1).Range("c" & x1 + i).Value = Range("b3").Value
          ThisWorkbook.Worksheets(1).Range("d" & x1 + i).Value = Range("b4").Value
          Application.DisplayAlerts = False
          wb.Close
          Application.DisplayAlerts = True
      End If
      Loop
      Application.ScreenUpdating = True
End Sub