Sub Окрыть_()
Dim dv
Dim nazv As String
Dim x As String
x = [A1] 'короткое название
Range("B1,A2").ClearContents
Range("A8:AA450").ClearContents
  sFolder = "D:\Погода\"
   sFiles = Dir(sFolder & x & "*.xls")
     Do While sFiles <> ""
         Workbooks.Open sFolder & sFiles
         sFiles = Dir
     Loop
     If ActiveWorkbook.Name = "Raschet.xls" Then
     MsgBox "ФАЙЛ  НЕ НАЙДЕН!"
     Exit Sub
     End If
         nazv = ActiveWorkbook.Name
    dv = Range("A1")
    Range(Cells(8, 1), Cells(450, 27)).Copy
      Windows("Raschet.xls").Activate
      Rows("8:8").Insert Shift:=xlDown
      Range("A2").Value = dv
      Range("B1").Value = nazv
    Application.CutCopyMode = False
Workbooks(Range("B1").Value).Close (False)
End Sub