Copy specific columns from a workbook to another using VBA

user_15170325 0
Viewed 805

I need help writing a macro that will copy and paste data from one workbook to a new workbook based on user input. That is, the macro should do 3 things:

  1. allow the user to select the workbook that contains the data to be copied into a new workbook.

  2. prompt the user to select the columns of data to copy into the new workbook, preferably by column header only.

  3. prompt the user to save the file.

The code below allows the user to select the workbook and places the range of data from the open workbook into a userform, but I don't know how to copy the selected data from that userform into a new workbook. The code also displays the data from the work book in rows, but I only want a list of the column headers.

Note: "multiColumnRange" is a defined name of the range of data, but this is 'hard-coded' that I would like to be dynamic. That is, the range of data will vary based on the workbook.

Sub Select_Workbook()

'Disables screen updating
Application.ScreenUpdating = False

'Defines the variable to hold the value of the file to open
Dim FileToOpen As Variant
'Defines the variable of the location of the file and the new workbook
Dim OpenBook As Workbook, NewBook As Workbook
     
Dim strCol As String

'Defines variable to hold value of table range
Dim rngMultiColumn As Range

 'Sets the variable to the file that is selected
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
'Checks if the user selected cancel and stores the Boolean value and not string
    If FileToOpen <> False Then
    Set OpenBook = Workbooks.Open(FileToOpen)
    
    'Define source range, referring to table's data range
    Set rngMultiColumn = OpenBook.Worksheets("Export").Range("multiColumnRange")
    
    With ufrmListBoxMultiColumn.lboxExampleMC
        .ColumnWidths = "120;120;120"
        .List = rngMultiColumn.Cells.Value
    End With
    
    ufrmListBoxMultiColumn.Show
    
    'Creates new workbook and assigns it to variable NewBook
    Set NewBook = Workbooks.Add

    End sub
vba excel
2 Answers

Use below code to call file picker

(i'll update the answer as I test the other part of code)

Dim FILE As String 'Use this to reference to the picked Workbook

'FilePicker 
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Choose the file"
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        .Show
        If .SelectedItems.Count = 0 Then
        MsgBox ("Choose file to load!")
        Exit Sub
        End If
        fullpath = .SelectedItems.Item(1)
    End With
FILE = Dir(fullpath)

Workbooks.Open (fullpath)
user_143298800

Try it

Sub move_data()

Dim data_wb As Workbook
Dim target_wb As Workbook
Dim file_name As Variant
Dim header_range(100) As Range
Dim last_row As Long
Dim col_number As Long
Dim col_letter As String
Dim counter As Long
Dim quantity As Long

'select workbook
file_name = Application.GetOpenFilename(Title:="Choose a target Workbook")

If file_name <> False Then

    'create a new target workbook
    Set target_wb = Application.Workbooks.Add

    'open Workbook with the data
    Set data_wb = Application.Workbooks.Open(file_name)
    
    'get quantity to create loop
    quantity = _
    InputBox("How many columns do you want to copy?")
    
    'loop
    For counter = 1 To quantity
    
        'select header range
        Set header_range(counter) = _
        Application.InputBox("Select the HEADER of the " & counter & "º column you want to copy", Type:=8)
        
        'get last row and col letter
        col_number = header_range(counter).Column
        last_row = Cells(Rows.Count, col_number).End(xlUp).Row
        col_letter = Split(Cells(1, col_number).Address(True, False), "$")(0)

        'copy from data_wb
        Range(header_range(counter), Range(col_letter & last_row)).Copy
        
        'pastein target_wb
        target_wb.Sheets("Sheet1").Cells(1, counter).PasteSpecial
        
    Next counter
    
    data_wb.Close
    
    If Not target_wb.Saved Then
        If MsgBox("Do you want to save the file?", vbYesNo, "Save?") = vbYes Then
            target_wb.Save
        End If
    End If

End If

target_wb.Close

End Sub
user_148959850
Related