Question

https://i.postimg.cc/fRR8SnG2/Untitled.jpg

Dim rng As Range
Dim lastRow As Long
Dim cell As Range

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A7:A" & lastRow + 1)
For Each cell In rng
    If cell.Value <> "" Then
        Range("H7:M7").Select
           Selection.Copy
           Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
           Application.CutCopyMode = False
    End If
Next cell

它正在复制下面的一行，如果g列中没有数据

Answer 1

它复制了另一行，因为您在第7行开始比较，但在第8行开始插入。只需将rng的范围从A7更改为A8

Dim rng As Range
Dim lastRow As Long
Dim cell As Range

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A8:A" & lastRow + 1)
For Each cell In rng
    If cell.Value <> "" Then
        Range("H7:M7").Select
           Selection.Copy
           Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
           Application.CutCopyMode = False
    End If
Next cell

如果单元格有价值，则将数据粘贴到相邻单元格

1 个答案: