Home > Back-end >  Copying 1 column from multiple sheets into one sheet in the same workbook and them copy/paste a 2nd
Copying 1 column from multiple sheets into one sheet in the same workbook and them copy/paste a 2nd

Time:12-11

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

CodePudding user response:

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.

CodePudding user response:

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
  • Related