复制包含空白的列而不跳过行..将“空白”留为空白VBA

时间:2018-10-06 15:41:24

标签: vba if-statement copy paste no-data

Aplication Defined error 使用运行多个宏的嵌入式按钮复制指定的列和范围(包括空白)。我知道所有行都将填充在A列中,因此,如果我可以将其余宏引用到A.end

我看过Google youtube,尽管这里有很多复制和粘贴的信息,但我找不到适合运行多个宏的内容。

Macros 5和6是我开始遇到问题的地方,因为这些列始终有多个空白。

要复制的原始数据:

Sheet1

目的地:

Sheet2

私人子CommandButton1_Click()

Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
        Worksheets("Sheet2").Range("a2") 'macro1

Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
        Worksheets("Sheet2").Range("b2")  'Macro2

Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
        Worksheets("Sheet2").Range("c2") 'macro3

Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
        Worksheets("Sheet2").Range("d2") 'macro4


If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
    Worksheets("Sheet2").Range("i2").Copy  'macro5

If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
        Worksheets("Sheet2").Range("j2").Copy 'macro6

Worksheets("Sheet2").Activate 'macro7

1 个答案:

答案 0 :(得分:0)

Range.end(xldown)只为您提供一个连续的范围(实际上它将在第一个空白单元格处停止)。

由于您要包含空格,因此您可能需要从工作表的最后一行一直回到该列中遇到的第一个非空白单元格(这是获得最后一行的一种方法)。

这将意味着:

' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows

With Worksheets("Sheet1")

.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1

End with

未经测试,写在手机上-但希望它能起作用或使您更接近解决方案。您将需要复制并粘贴以上内容,并将A更改为B,C,D,E等。我不太确定您要在宏中使用“ <0”条件实现的目标5和6。

(最好将代码转换为参数化的Sub并仅将列字母/数字作为子变量的参数提供,但这取决于您对VBA和一般编程的新颖程度-并暂时使您更容易理解/维护。)

针对宏5和6进行编辑

With Worksheets("Sheet1")

Dim cell as range

For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))

If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'

Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5

ElseIf cell.value > 0 Then

Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If

Next cell

End With



Worksheets("Sheet2").Activate 'macro7