Объединение столбцов в макрос

Question

Я знаю, что эта тема охвачена множеством разных способов. Я только начал смотреть на vba и макрос сегодня, но я не смог найти или настроить какие-либо решения, которые я нашел.

Я собираю 4 столбца данных в 4 различных файлах excel с примерно 500 столбцами и 2-4k строк данных в каждом файле.

Я понял, как скомпоновать интересующие столбцы в один файл excel со следующим (неэлегантным) решением (см. Ниже).

Я надеюсь, что кто-то может указать мне на то, как взять эти 16 столбцов и изменить их на 4 столбца (или если кто-нибудь сможет объяснить, как получить данные в 4 столбца, в первую очередь, что также было бы замечательно) ,

Спасибо!

Sub Macro2() 

' Macro2 Macro 


    Workbooks.Open Filename:="[path]" 
    Workbooks.Open Filename:="[path]" 
    Workbooks.Open Filename:="[path]" 
    Workbooks.Open Filename:="[path]" 

    Workbooks("Stroop_Distressing_A_out.csv").activate 
     Sheets("Stroop_Distressing_A_out.csv").select 
      Range("GL:GL, HP:HP, IJ:IJ, IS:IS").copy 
    Workbooks("Merge Excel Data Macro1.xlsm").activate 
     Sheets("Sheet1").select 
      Range("A:D").select 
      ActiveSheet.Paste 

    Workbooks("Stroop_Distressing_B_out.csv").Activate 
    Sheets("Stroop_Distressing_B_out.csv").Select 
      Range("GL:GL, HP:HP, IK:IK, IT:IT").Copy 
    Workbooks("Merge Excel Data Macro1.xlsm").Activate 
     Sheets("Sheet1").Select 
       Range("E:H").Select 
    ActiveSheet.Paste 


    Workbooks("Stroop_Distressing_C_out.csv").activate 
     Sheets("Stroop_Distressing_C_out.csv").select 
      Range("DV:DV, EZ:EZ, FU:FU, GD:GD").copy 
    Workbooks("Merge Excel Data Macro1.xlsm").activate 
     Sheets("Sheet1").select  
    Workbooks("Merge Excel Data Macro1.xlsm").Activate 
     Sheets("Sheet1").Select 
       Range("I:L").Select 
    ActiveSheet.Paste 

    Workbooks("Stroop_Distressing_D_out.csv").activate 
     Sheets("Stroop_Distressing_D_out.csv").select 
      Range("GL:GL, HP:HP, IK:IK, IT:IT").copy 
    Workbooks("Merge Excel Data Macro1.xlsm").activate 
     Sheets("Sheet1").select  
     Workbooks("Merge Excel Data Macro1.xlsm").Activate 
     Sheets("Sheet1").Select 
       Range("M:P").Select 
    ActiveSheet.Paste 

End Sub 

Answer 1

При условии, что ваш VBA макрос успешно завершен, остальные задачи может быть выполнен с использованием следующих подразделов:

Sub AggregateColumns() 
    Dim wsSource As Worksheet 
    Dim wsTarget As Worksheet 
    Dim maxRowSource As Integer 
    Dim maxRowTarget As Integer 

    Set wsSource = Sheets("Sheet1") 
    Set wsTarget = Sheets("Sheet2") 

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row 
    wsSource.Range("A1:D" & maxRowSource).Copy Destination:=wsTarget.Range("A1") 

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "E").End(xlUp).Row 
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row 
    wsSource.Range("E1:H" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1) 

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "I").End(xlUp).Row 
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row 
    wsSource.Range("I1:L" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1) 

    maxRowSource = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row 
    maxRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row 
    wsSource.Range("M1:P" & maxRowSource).Copy Destination:=wsTarget.Range("A" & maxRowTarget + 1) 

End Sub 

Надеется, что это поможет.