Страницы: 1
RSS
Найти в другой книге лист с таким же именем и скопировать из него данные.
 
День добрый. Есть две книги "Результат.xlsx" и "Данные.xlsx" нужно как-то найти в файле "Данные.xlsx" Лист имя которого совпадает с именем текущего листа в файле "Результат.xlsx" , скопировать данные из диапазона C4:L4 из файла "Данные.xlsx" и вставить их в файл "Результат.xlsx".(диапазон C2:L2)
Изменено: ДенExcel111 - 09.04.2020 09:25:31
 
Код
Const WB_NAME = "Данные.xlsx"
'
Sub Тренажёрка()
    Dim wb As Workbook
    Dim sh As Worksheet
    
    On Error Resume Next
        Set wb = Workbooks(WB_NAME)
        If Err <> 0 Then
            MsgBox "Не найдена книга " & WB_NAME, vbInformation
            Exit Sub
        End If
        
        Set sh = wb.Sheets(ActiveSheet.Name)
        If Err <> 0 Then
            MsgBox "Не найден лист " & ActiveSheet.Name, vbInformation
            Exit Sub
        End If
    On Error GoTo 0
    
    Dim a As Variant
    Dim y As Long
    
    With sh
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        a = .Range(.Cells(2, 1), .Cells(y, 7))
    End With
    
    Dim x As Integer
    Dim b As Variant
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) - 1)
    
    For y = 1 To UBound(a, 1)
        For x = 1 To 2
            b(y, x) = a(y, x)
        Next
        For x = 4 To UBound(a, 2)
            b(y, x - 1) = a(y, x)
        Next
    Next
    
    With ActiveSheet
        .Range(.Cells(3, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
        .Cells(3, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
        
        .Rows(2).Copy
        .Rows(3).Resize(UBound(b, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End With
End Sub
Страницы: 1
Наверх