Copying specific columns from several workbooks to one master workbook, without constantly editing code

Question

I am trying to read a specific set of columns from a workbook (every week it is a new workbook) and copy them into another workbook. This I have been able to do, but I think there is a cleaner way to do it!! My code is very bulky and problematic, as every week I need to read info from a different workbook so I have to go back into the code and change the workbook file name. I would love any input on how to improve the code and speed up changing the file name for the workbook from which columns are copied....for example is it possible to ask the user to input the file name in place of a static name??

Any feedback / suggestions are greatly appreciated!!! My code is below:

Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range


Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")


sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub

score 0 · Answer 1 · answered Feb 03 '13 at 12:48

A simple way to neatly take user input is to use the InputBox function

Sub ReadInputBox()

    Dim readWorkbookLocation As String
    readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")

    MsgBox workbookFile

End Sub

score 0 · Answer 2 · edited May 23 '17 at 10:24

Yup. You can use the Application.GetOpenFilename to let the user choose the file name. For example

Option Explicit

Sub Sample()
    Dim Ret
    Dim Wb As Workbook
    Dim ws As Worksheet

    Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

    If Ret <> False Then
        Set Wb = Workbooks.Open(Ret)
        Set ws = Wb.Sheets("Sheet1")

        With ws
            '
            '~~> Do whatever you want to do here with the worksheet
            '
        End With
    End If
End Sub

EDIT: I just noticed that You have tagged it as excel-vba-mac as well. If you are doing this on Excel 2011 then see this link which shows how to use the Application.GetOpenFilename. The rest of the code remains as it is.

score 0 · Answer 3 · answered Feb 03 '13 at 17:07

For these type of operations, I use a separate Excel file that contains the vb codes. (I'll call this file "Operation"). On a worksheet put the name of the source/destination file. Add buttons such as "Select Source", "Select Destination", which would prompt for a file but put the selected filename on the sheet only. Another button "Go" will do the actual operation using the files specified, something like:

enter image description here

If the columns to be copied seldom change, you can leave it inside VBA. If it changes from time to time or you need several versions, put it on the Operation worksheet too. If you need a more complex scenario, you can put the configuration on another worksheet in the sources/destination workbooks, so authors can specify the columns themselves.

As a suggestion for your code, use constants/variable for the filenames, to minimize typing when changing filenames manually. Also assign to variables the Workbook and Worksheet being operated on.

' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet

' SOURCE
Dim srcFN as string

' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"

' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )

Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )

' DESTINATION
.... do the same ...

.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....

.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
    Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
    Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
    srcRange.Copy Destination:=dstRange
    currentRow = currentRow + 1
Wend

score 0 · Answer 4 · answered Feb 03 '13 at 19:21

You may use the following simple code to loop over all the files in the folder without knowing their names and quantity:

LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop

Wildcards are allowed in filemask. Good luck!

Copying specific columns from several workbooks to one master workbook, without constantly editing code

4 Answers4