在 Excel VBA 中将三列复制到一列

Copy three columns into one column in Excel VBA

提问by dhammikai

I need help to create a Excel VBA macro. I have a workbook contains 4 worksheets. Coulmn "A" in worksheet number 1, 2 and 3 are filled with data. I need to copy these data into Sheet 4 Column "A". I already done this by using this code but it dosn't work (it only copy the data by replacing ..).

我需要帮助来创建 Excel VBA 宏。我有一个包含 4 个工作表的工作簿。工作表编号 1、2 和 3 中的 Coulmn "A" 填充了数据。我需要将这些数据复制到工作表 4 列“A”中。我已经使用此代码完成了此操作，但它不起作用（它仅通过替换 .. 来复制数据）。

EXAMPLE (I need to do following)

示例（我需要执行以下操作）

(Sheet 1 Col. A)
1
2
3
4

(Sheet 2 Col. A)
5
6

(Sheet 3 Col. A)
7
8
9

Need to copy all above in sheet 4 Col. A as follows

需要将以上所有内容复制到工作表 4 第 A 列中，如下所示

1
2
3
4
5
6
7
8
9

So, I wrote a code as follows

所以，我写了一个代码如下

Sub CopyColumnToWorkbook()
    Dim sourceColumn As Range, targetColumn As Range

    Set sourceColumn = Worksheets("Sheet1").Columns("A")
    Set targetColumn = Worksheets("Sheet4").Columns("A")

    sourceColumn.Copy Destination:=targetColumn
End Sub

Sub CopyColumnToWorkbook2()

    Dim sourceColumn As Range, targetColumn As Range

    Set sourceColumn = Worksheets("Sheet2").Columns("A")
    Set targetColumn = Worksheets("Sheet4").Columns("A")

    sourceColumn.Copy Destination:=targetColumn
End Sub

Sub CopyColumnToWorkbook2()

    Dim sourceColumn As Range, targetColumn As Range

    Set sourceColumn = Worksheets("Sheet3").Columns("A")
    Set targetColumn = Worksheets("Sheet4").Columns("A")

    sourceColumn.Copy Destination:=targetColumn
End Sub

This above coding is not work as I need. Someone please help me to do as in above EXAMPLE.

上面的编码不能按我的需要工作。有人请帮助我按照上面的示例进行操作。

Thank you very much.

非常感谢。

采纳答案by aevanko

This is quick code I threw together just to get you on the right track. It can be cleaned up. Basically you want to look through each sheet and see what the last column used is, then copy the entire used range for column A, and paste it onto the master sheet, starting from the last cell used in column A. You don't want to paste entire columns, so I used "End(xlUp)" which find the last cell used in column A.

这是我拼凑起来的快速代码，只是为了让您走上正轨。它可以被清理干净。基本上，您想查看每个工作表并查看最后使用的列是什么，然后复制 A 列的整个使用范围，并将其粘贴到主工作表上，从 A 列中使用的最后一个单元格开始。您不想要粘贴整个列，所以我使用了“End(xlUp)”，它可以找到 A 列中使用的最后一个单元格。

Sub ColumnAMaster()

Dim lastRow As Long, lastRowMaster As Long
Dim ws As Worksheet
Dim Master As Worksheet

Application.ScreenUpdating = False
Set Master = Sheets.Add
Master.Name = "Master"
lastRowMaster = 1

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Master" Then
        lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A1:A" & lastRow).Copy Destination:=Master.Range("A" & lastRowMaster)
        lastRowMaster = Master.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If
Next

Application.ScreenUpdating = True
MsgBox "Done!"

End Sub

Sorry StackOverflow is not indenting the code as it should...

抱歉，StackOverflow 没有按照应有的方式缩进代码...

Things you may want to do: check if there is any data at all inside each sheet before copying A over to the master, loop through worksheets in a specific order, check if a 'master' sheet exists or not already, etc.

您可能想做的事情：在将 A 复制到母版之前检查每张工作表中是否有任何数据，以特定顺序循环工作表，检查“母版”工作表是否存在等。

回答by zoonosis

Here is another way, very quick and basic but does the job
You could obviously combine all of those 3 do loops into one loop

这是另一种方式，非常快速和基本但可以完成工作
您显然可以将所有这 3 个 do 循环组合成一个循环

Dim x As Integer
Dim y As Integer

x = 1
y = 1

Do Until Worksheets("Sheet1").Range("A" & x) = ""
    Worksheets("Sheet4").Range("A" & y) = Worksheets("Sheet1").Range("A" & x)
    y = y + 1
    x = x + 1
Loop

x = 1
Do Until Worksheets("Sheet2").Range("A" & x) = ""
    Worksheets("Sheet4").Range("A" & y) = Worksheets("Sheet2").Range("A" & x)
    y = y + 1
    x = x + 1
Loop

x = 1
Do Until Worksheets("Sheet3").Range("A" & x) = ""
    Worksheets("Sheet4").Range("A" & y) = Worksheets("Sheet3").Range("A" & x)
    y = y + 1
    x = x + 1
Loop