excel 将多个工作表中的一列复制到同一工作簿的一个工作表中，然后从同一最终工作表中复制/粘贴第二列

m1m5dgzv 于 2022-12-14 发布在其他

关注(0)|答案(2)|浏览(195)

我是VBA的新手，我的目标是自动从3个指定的工作表（源工作表）中复制一个列（B），并将它们粘贴到一个新的工作表中，然后对C列重复此过程，直到定义一个列（我的目标见图，在这种情况下，我希望直到源工作表的D列）。所有工作表的结构都是相同的。列由数值组成。
我试着写一段代码（见下面），但是我在注解行得到了运行时错误1004。而且，不确定代码是否会做我想做的事情。我做错了什么？有什么改进的建议吗？

Sub CopyColumns3()

Dim sheetNames As Variant
sheetNames = Array("temp_column", "normalized_column", "derivative_column")

Dim columnLetters As Variant
columnLetters = Array("B", "C", "D")

Dim i As Integer
Dim j As Integer

' Create a new sheet after the last sheet in the workbook
sheets.Add After:=sheets(sheets.Count)

' Set the name of the new sheet
sheets(sheets.Count).Name = "A_final"

For i = 0 To UBound(sheetNames)
    For j = 0 To UBound(columnLetters)
        sheets(sheetNames(i)).columns(columnLetters(j)).Copy

        ' Check if there are any empty columns in the Destination sheet
        If sheets("A_final").Range("A1").End(xlToRight).Column = 256 Then
            ' If there are no empty columns, add a new column to the end of the sheet
            sheets("A_final").columns(sheets("A_final").columns.Count).EntireColumn.Insert
        End If

        sheets("A_final").Select
        ' The next line causes the problem
        sheets("A_final").Range("A1").End(xlToRight).Offset(0, 1).PasteSpecial
    Next j
Next i

End Sub

enter image description here

excel

来源：https://stackoverflow.com/questions/74756248/copying-1-column-from-multiple-sheets-into-one-sheet-in-the-same-workbook-and-th

2条答案

按热度按时间

ppcbkaq51#

复制列

Sub ColumnsToNewSheet()

    ' Define constants.
    
    Const DST_NAME As String = "A_final"
    Const DST_FIRST_COLUMN As String = "A"
    
    Dim sNames(): sNames = Array( _
        "temp_column", "normalized_column", "derivative_column")
    Dim sColumns(): sColumns = Array("B", "C", "D")

    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Add a new sheet, rename it and reference the first Destination column.
    Dim dws As Worksheet
    Set dws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    dws.Name = DST_NAME
    Dim drg As Range: Set drg = dws.Columns(DST_FIRST_COLUMN)
    
    ' Copy the Source columns to the Destination columns.
    ' This does sh1-col1,sh2-col1,sh3-col3... as requested.
    ' If you need sh1-col1,sh1-col2,sh1-col3... switch the loops.
    
    Dim srg As Range, sName, sColumn
    
    For Each sColumn In sColumns
        For Each sName In sNames
            Set srg = wb.Sheets(sName).Columns(sColumn)
            srg.Copy drg
            Set drg = drg.Offset(, 1) ' next Destination column
        Next sName
    Next sColumn

    ' Inform.
    MsgBox "Columns exported.", vbInformation

End Sub

赞(0）回复(0）举报 2022-12-14

mo49yndu2#

我不明白你为什么要为第256栏开支票。
但是，当它被触发时，您调用Range.Insert，这将清除CutCopyMode。因此，Range.PasteSpecial将失败，因为没有要粘贴的内容。
您可以将检查移到Range.Copy调用之前，或者完全删除它。

赞(0）回复(0）举报 2022-12-14