循环：将单元格值（在列表中）从一个工作表复制到另一个工作表

Question

此宏的目的是将一个单元格值（从一个长列表中）复制到位于不同工作表中的另一个单元格。

这是我的代码：

Sub journalben()

Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")

    Set Rng = Range("G2:G1048576")
    For Each cell In Rng
        'test if cell is empty
        If cell.Value <> "" Then

        finaljnl.Range("L4").Value = rawben.Range("G5").Value
        finaljnl.Range("K4").Value = rawben.Range("L5").Value
        End If
    Next
End Sub

借助图片，我将解释我想要实现的目标：

1. 在 Sheet1（“BEN”）中，G 和 L 列中有一个列表。
2. 我将从 Sheet1 复制单元格 G5 并将其粘贴到 Sheet2 ("JNL_BEN") Range K4 中。
3. 接下来我将从 Sheet1 复制单元格 L5 并将其粘贴到 Sheet2 ("JNL_BEN") Range L4 中。
4. 复制下一行，和第2行和第3行一样，但这次会调整下面的1行。
5. 复制整个列表。这意味着到底部。该列表是动态的，有时会包含 5,000 行。

由于某些原因，复制整个列不是此宏的选项，因为必须将 sheet1 中的单元格从左到右（或水平）粘贴或放置在 Sheet2 中。

我希望你能抽出一些时间来帮助我。我的代码不起作用，我猜 FOR EACH 的实现不正确。我不确定 FOR EACH 是否是最好的代码。

感谢任何人对此的帮助。非常感谢！愿原力与你同在。

Answer 1

试试这个：

Sub journalben()
    Dim i As Long, lastRow As Long

    Set rawben = Sheets("BEN")
    Set finaljnl = Sheets("JNL_BEN")

    lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row

    For i = 5 To lastRow
        'test if cell is empty
        If rawben.Range("G" & i).Value <> "" Then
            finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
            finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
        End If
    Next i
End Sub

我从5 开始FOR，因为您图像中的数据从单元格G5 开始（不考虑标题）。

Answer 2

为此使用数字变量会更容易：

Sub journalben()

Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")

    Set Rng = rawben.Range("G4:G1048576")
    For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
        'test if cell is empty
        If rawben.Range("G" & i).Value <> vbNullString Then
            finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
            finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
        End If
    Next i
End Sub

Answer 3

您应该使用简单的 for 循环。使用起来更容易。

此外，要使其动态化并转到范围中的最后一个单元格，请使用 SpecialCells 方法。

您的范围需要从第 5 行开始正确设置。

代码如下：

Sub journalben()

Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")

    Set Rng = Range("G5:G1048576")
    For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
        If rawben.Range("G" & i).Value <> vbNullString Then
            finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
            finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
        End If
    Next i
End Sub