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

Question

I am relative novice in VBA and my goal is to automatically copy one column (B) from 3 named sheets (source sheets) and paste them in a new sheet and them repeat the process for column C and so on until a defined column (see image for my goal, in this case I wanted until column D of the source sheets). The structure of all sheets is identical. Columns consist of numeric values.

I have tried to write a code (see below) however I am getting run-time error 1004 for the commented line. Also, not sure if the code will do what I want to. What am I doing wrong and any tips to improve it?

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

Answer 1

Copy Columns

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

Answer 2

I do not see why should you have that check for column 256.

However, when it is triggered, you call Range.Insert , which clears the CutCopyMode . Therefore, Range.PasteSpecial fails because there is nothing to paste.

You can move the check before the Range.Copy call, or get rid of it altogether.