'Copying specific colums into another file [VBA

i have the following problem. I want to write a Macro, that copies three specific columns from a file "Rest.xlsx" into the original file "Schweben.xlsm". Both files are attached.

I already have the following code, which copies specific columns within the original file "Schweben.xlsm" from the table1 to a new created table2. Now i also want the macro to copy the columns K,H,D form Rest.xlsx to table2 within the "Schweben.xlsm" file into the new columns F,G,J (in that specific order). Since the files change daily, I want the macro to recognize the different lengths of the columns and always recognize all cells within the column, even if it is sometimes longer.

Sub CopyRowE()
    Dim LastRowE As Long
    Dim LastRowH As Long
    Dim LastDataRow As Long
    Dim CopyData As Long

    With Tabelle1
    
        LastRowE = .Range("E9999").End(xlUp).Row
        LastRowH = .Range("H9999").End(xlUp).Row
    
        .Range("E2:E" & LastRowE).Copy
        .Range("CA1").PasteSpecial
        .Range("H2:H" & LastRowH).Copy
        .Range("CB1").PasteSpecial
    
         LastDataRow = .Range("CB999999").End(xlUp).Row
         .Range("CA1:CB" & LastDataRow).Copy
    
         Sheets.Add
    
         ActiveSheet.Range("A1").PasteSpecial
    
         .Range("CA1:CB" & LastDataRow).ClearContents
    
         Tabelle1.Select
         .Range("A1").Select

     End With
 End Sub

Thanks in advance



Solution 1:[1]

Here is a simplified approach to copy columns of data from one sheet to another. I've matched what you asked for as best as I could understand your needs and commented the code well, so you can follow it. The important part here is the creation of a sub procedue that named "copy_column" that actually doest he copying when supplied with a source and destination cell.

Sub copyRowE()
    Dim new_sheet As Worksheet
    Dim source As Range
    Dim dest As Range
    Dim rest_sheet As Worksheet
    
    'this code assumes that the Rest.xlsx workbook is open,  if not, correct the
    'following line and remove the comment character (')
    'workbooks.open("c:\full\path\to\Rest.xlsx")
    
    ' copy E from tabelle1 to column A on new sheet
    Set new_sheet = ThisWorkbook.Sheets.Add
    
    'give new_sheet a name
    'new_sheet.name = "Consolidated"
    
    copy_column tabelle1.Range("E2"), new_sheet.Range("A1")
    
    'copy H from tabelle1to column B on new sheet
    copy_column tabelle1.Range("h2"), new_sheet.Range("B1")
    
    
    'copy from the first sheet in rest.xlsx
    Set rest_sheet = Workbooks("Rest.xlsx").Worksheets(1)
    
    'OR copy from a particular sheet in Rest.xlsx
    'Set rest_sheet = Workbooks("Rest.xlsx").Worksheets("Sheet1")
    
    'copy column K from rest to column F on the new sheet
    copy_column rest_sheet.Range("K2"), new_sheet.Range("F1")
    
    'copy column H from rest to column G on the new sheet
    copy_column rest_sheet.Range("H2"), new_sheet.Range("G1")
    
    'copy column D from rest to column J on the new sheet
    copy_column rest_sheet.Range("D2"), new_sheet.Range("J1")
    
End Sub


Sub copy_column(top_cell_in_source_column As Range, dest_cell As Range)
    ' copies data starting at top_cell_in_source_column and taking all data below it
    ' and pastes it beginning at dest_cell.  The source and destination can be in
    ' different worksheets or even in different workbooks
    
    Dim source_sheet As Worksheet
    Dim source_col As Long
    
    Set source_sheet = top_cell_in_source_column.Parent
    source_col = top_cell_in_source_column.Column
    
    Range(top_cell_in_source_column, source_sheet.Cells(source_sheet.Rows.Count, source_col).End(xlUp)).Copy dest_cell
    
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Gove