首页 > 解决方案 > 如何将特定的数据单元格(跳过空白单元格)复制到另一个工作表到下一个空白行中?

问题描述

我有一个电子表格,用于调查多种设备的设备状况(请参阅数据输入示例)。对于每一行,我需要将列标题“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

标签: excelvbacopy-pastedata-manipulation

解决方案


您是否尝试指定函数的SkipBlanks参数PasteSpecial

您的代码看起来像这样:

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

有关详细信息,请参阅Range.PasteSpecial 方法 (Excel)


推荐阅读