excel - 循环行以从一个工作表的列复制到另一个工作表

Question

我需要使用一张表中的数据来填写同一工作簿中的另一张表。

使用 sheet1 的数据:

C 列的项目将被复制到 Sheet2，并且任何相关信息也将被复制。

然后将 D 列的项目及其相关信息复制到下一行。

这将重复，直到 Sheet1 中的所有行都复制到 Sheet2。

(注意:我将此宏作为按钮放在另一张表中，因此我在代码中引用了每张表。)

      NumRows = Worksheets("Sheet1").Range("C2", Range("C2").End(xlDown)).Rows.Count
      ' Select cell, *first line of data*.
      Worksheets("Sheet1").Range("C2").Select
      ' Set Do loop to stop when ten consecutive empty cells are reached. (Make sure it's safely run; ignore)
      j = 4
      Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(10, 0))
         For i = 2 To NumRows
            j = j + 1
            Worksheets("Sheet1").Cells(i, "C").Value = Worksheets("Sheet2").Cells(j, "C").Value
        Worksheets("Sheet1").Cells(i, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
        Worksheets("Sheet1").Cells(i, "B").Value = Worksheets("Sheet2").Cells(j, "B").Value
        Worksheets("Sheet1").Cells(i, "E").Value = Worksheets("Sheet2").Cells(j, "D").Value
            ' New row for next item
        j = j + 1
            Worksheets("Sheet1").Cells(i, "D").Value = Worksheets("Sheet2").Cells(j, "C").Value
        Worksheets("Sheet1").Cells(i, "A").Value = Worksheets("Sheet2").Cells(j, "A").Value
        Worksheets("Sheet1").Cells(i, "B").Value = Worksheets("Sheet2").Cells(j, "B").Value
        Worksheets("Sheet1").Cells(i, "E").Value = Worksheets("Sheet2").Cells(j, "D").Value
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Next
      Loop
    Application.ScreenUpdating = True
End Sub

Answer 1

您的代码正在从 sheet2 复制到 sheet1。

Option Explicit

Sub Macro1()

    Dim j As Long, i As Long, c As Long
    Dim ws2 As Worksheet, lastrow As Long
    Set ws2 = Sheets("Sheet2")
    j = 1
    Application.ScreenUpdating = False
    With Sheets("Sheet1")
        lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
        For i = 2 To lastrow
            For c = 3 To 4
                If Len(.Cells(i, c)) > 0 Then
                    j = j + 1
                    ws2.Cells(j, "A") = .Cells(i, "A")
                    ws2.Cells(j, "B") = .Cells(i, "B")
                    ws2.Cells(j, "C") = .Cells(i, c)
                    ws2.Cells(j, "D") = .Cells(i, "E")
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox j-1 & " rows copied", vbInformation
    
End Sub