Sub test()
    InsertToCell ActiveCell, "C:\Users\ABMayorov\Documents\описания", "Пересчет СДТ (1).xlsx"
End Sub

Sub InsertToCell(cl As Range, sPath As String, sWb As String)
    Dim wb As Workbook
    
    On Error Resume Next
        Set wb = Workbooks.Open(sPath & "\" & sWb, False, True)
    On Error GoTo 0
    
    If wb Is Nothing Then
    Else
        Dim sh As Worksheet
        On Error Resume Next
            Set sh = wb.Sheets(1)
        On Error GoTo 0
        
        With sh
            Dim x As Integer
            Dim y As Long
            Dim arr As Variant
            x = .Cells(1, .Columns.Count).End(xlToLeft).Column
            y = .Cells(.Rows.Count, 1).End(xlUp).Row
            If y = 1 And x = 1 Then y = 2
            
            arr = .Range(.Cells(1, 1), .Cells(y, x))
        End With
        
        wb.Close False
        
        cl.Resize(UBound(arr, 2), UBound(arr, 1)) = Application.Transpose(arr)
    End If
End Sub

Sub InsertToCell(sPath As String, sWb As String)
    Dim wb As Workbook     - почему то горит как ошибка
    Set wb = Workbooks.Open(sPath & "\" & sWb, False, True)
    Dim CopyRange as Range: Set CopyRange = wb.Worksheets("Sheet1").Range("A1:r2")   - почему то тоже горит как ошибка
    Dim PasteRange As Range: Set PasteRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:B16")
    CopyRange.Copy
    PasteRange.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    wb.Close False
    
End Sub

Sub InsertToCell(sPath As String, sWb As String)
    Dim wb As Workbook
    Set wb = Workbooks.Open(sPath & "\" & sWb, False, True)
    Dim CopyRange as Range: Set CopyRange = wb.Worksheets(1).Range("A1:R2")
    Dim PasteRange As Range: Set PasteRange = ThisWorkbook.Worksheets(1).Range("A1:B16")
    CopyRange.Copy
    PasteRange.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    wb.Close False
End Sub

Sub Дата()
Dim wb As Workbook
Dim sWb As String
sPath = InputBox("Укажите путь к файлу")
sWb = ThisWorkbook.Worksheets(1).Cells(1, 10).Value
Set wb = Workbooks.Open(sPath & "\" & sWb, False, True)
Dim CopyRange As Range: set CopyRange = wb.Worksheets(1).Range("A1:R2")
Dim PasteRange As Range: Set PasteRange = ThisWorkbook.Worksheets(1).Range("A1:B16")
CopyRange.Copy
PasteRange.PasteSpecial Paste:=xlPasteAll, Transpose:=True
wb.Close False
End Sub

Sub Дата()
Dim wb, ab As Workbook
Dim sWb As String
Dim sh As Worksheet
Set ab = ActiveWorkbook
sPath = InputBox("Укажите путь к файлу")
sWb = ThisWorkbook.Worksheets(1).Cells(1, 10).Value
Set wb = Workbooks.Open(sPath & "\" & sWb, False, True)
Set sh = wb.Worksheets(1)
With sh
Dim CopyRange As Range: set CopyRange = Range("A1:R2").Select
Selection.Copy
End With
ab.Worksheets(1).Range("A1:B16").PasteSpecial Paste:=xlPasteAll, Transpose:=True
wb.Close False
End Sub