如何将特定的数据单元格（跳过空白单元格）复制到另一个工作表中的下一个空白行中？

Question

我有一个电子表格，可以调查多种设备的设备状况（请参阅数据输入示例）。对于每一行，我需要将列标题“ E1”和“ E1C”下的设备复制/粘贴到具有ID号的另一个工作表（例如，“ ET目标”）中，然后将“ E2”和“ E2C”副本粘贴到下一个空白中具有相同ID的行。继续为每行中的每个非空白单元格执行此操作。

数据输入示例

“数据输出示例”图像可以帮助解释我的意思。

我已经尝试了一些事情并阅读了很多文章，但是还没有发现我可以结合起来使用的任何东西。以下是我目前正在从事的工作，但还远未完成。

编辑：到目前为止的新代码。可以，但是想学习如何循环和跳过空格

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Dim source As Worksheet, target As Worksheet


    'range is B:L.  B8:L8 empty so skipped
    'next is B9:L9.  skip J9:L9 becuase empty
    Sheets("Source").Range("B9:C9,A9").Copy
    Sheets("ET target").Range("A2").PasteSpecial xlValues
    Sheets("Source").Range("D9:E9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D9:E9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("F9:G9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("H9:I9,A9").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Skip B10:L10 empty.  Next is B11:L11.  Skip F11:L11 becuase empty
    Sheets("Source").Range("B11:C11,A11").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D11:E11,A11").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Skip B12:L14 becuase empty.  Next is B15:L15.  skip H15:L15 becuase empty
    Sheets("Source").Range("B15:C15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("D15:E15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    Sheets("Source").Range("F15:G15,A15").Copy
    Sheets("ET target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    'Repeat for upto 200 rows.

'Same steps but for other Equipment.
'Range is M:AB. Skip
Sheets("Source").Range("M9:N9,A9").Copy
Sheets("UT target").Range("A2").PasteSpecial xlValues

Application.ScreenUpdating = True

End Sub

Answer 1

您是否尝试指定SkipBlanks函数的PasteSpecial自变量？

您的代码看起来像这样：

Sheets("Source").Range("B9:C9,A9").Copy
Sheets("ET target").Range("A2").PasteSpecial Paste:=xlValues, SkipBlanks:=True

有关更多信息，请参见Range.PasteSpecial method (Excel)。