Динамическое копирование данных из одной рабочей книги в другую с использованием вложенного For l oop в VBA

Question

Я хочу скопировать все данные из 1-й рабочей книги во 2-ю рабочую книгу динамически, используя вложенный файл For L oop. Из 1-й рабочей книги я не хотел копировать заголовок и вставлять данные во 2-ю рабочую книгу после строки 2, т.е. строки формы 3.

Приведенный ниже код не копирует все значения, я думаю, что есть проблема во вложенных L oop.

Sub Copy_data(FTO_2, FTO_1 As Variant)

Dim OB1, OB2 As Workbook
Dim x1, y1, x2, y2, lr1, lc1, lr2, lc2 As Long


Application.ScreenUpdating = False

    Set OB2 = Application.Workbooks.Open(FTO_2)
        OB2.Worksheets(1).Activate

        lr2 = OB2.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
        lc2 = OB2.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column


    Set OB1 = Application.Workbooks.Open(FTO_1)
        OB1.Worksheets(1).Activate
        lr1 = OB1.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
        lc1 = OB1.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column


         For x1 = 2 To lr1
            For y1 = 1 To lc1

                For x2 = 3 To lr2
                    For y2 = 1 To lc2

                        OB2.Worksheets(1).Cells(x2, y2) = OB1.Worksheets(1).Cells(x1, y1)

                    Next y2
                Next x2

            Next y1
        Next x1
End Sub

Answer 1

Цикл через каждую ячейку и копирование неэффективно, вы должны передать весь диапазон.

Sub MoveRangeData()
    Dim OB1 As Workbook: Set OB1 = Application.Workbooks.Open(FTO_1)
    Dim OB2 As Workbook: Set OB2 = Application.Workbooks.Open(FTO_2)

    Dim srcSht As Worksheet: Set srcSht = OB1.Sheets("Sheet1")
    Dim destSht As Worksheet: Set destSht = OB2.Sheets("Sheet1")

 'Define source range (I prefer to use "Find" to get the last row and column)
 'The ".Row - 1" adjust the row count because the start row = 2, not 1.
 'The "*" finds the last filled row. 
 'The "" finds the first empty column.
 'The ".Column - 1" shifts left to the last used column.
    Dim srcrng As Range
    Set srcrng = srcSht.Range("A2").Resize(srcSht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1, srcSht.Cells.Find(What:="").Column - 1)

'Define destination range, by using the "srcrng", rows.count and columns.count to resize the destination range.
    Dim destrng As Range
    Set destrng = destSht.Range("A3").Resize(srcrng.Rows.Count, srcrng.Columns.Count)

'Set destination range values equal to source range values
    destrng.Value = srcrng.Value
End Sub

Answer 2

Как я уже говорил в моем комментарии выше, этот алгоритм должен быть более подходящим

EDIT : исправлена ​​ошибка опечатки в targetOrigin имя переменной

Dim targetOrigin As Range
' Reference to the top-left cell of the target range to fill
Set targetOrigin = OB2.Worksheets(1).Cells(3, 2)

' Return the last row number of the used area
' (Actually it returns the number of rows but I have never checked if the starting row could differ from #1. While the starting row is row #1, Rows.Count is equal to the last row number)
lr1 = OB1.Worksheets(1).UsedRange.Rows.Count
' Return the last column number of the used area
lc1 = OB1.Worksheets(1).UsedRange.Columns.Count

For x1 = 2 To lr1
    For y1 = 1 To lc1
        ' Row offset : x1 - 2 because x1 starts with 2
        ' Column offset : y1 - 1 because y1 starts with 1
        targetOrigin.Offset(x1 -2, y1 -1).Value = OB1.Worksheets(1).Cells(x1, y1).Value
    Next y1
Next x1

с для этого вам не нужно определять последний столбец и строку вашей целевой таблицы. За исключением случаев, когда вам нужно сначала очистить содержимое этого листа