在VBA中使用嵌套的For循环将数据从一个工作簿动态复制到另一个工作簿中。

Question

我想使用嵌套的For Loop将所有数据从1号工作簿动态复制到2号工作簿。我不想从第1个工作簿中复制页眉&将数据粘贴到第2个工作簿的第2行后，即第3行。

下面的代码并没有复制所有的值，我认为嵌套For Loop有问题。

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

正如我在上面的评论中所说的，这种算法应该更合适

编辑 : 修正以下文字错误 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

有了这个功能，你不需要确定目标工作表的最后一列和一行。除非你需要先清除这个工作表的内容。

Answer 2

在每个单元格中循环复制效率低下，你应该转移全部范围。

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