Creating a VBA macro that creates a new consolidated workbook from columns of another excel data-set

Question

I am trying to create script to a macro that will copy certain columns in a large data-set in excel and create a new excel workbook of those columns in respective order -- Only the values to be copied over and not the formulas. This is what I have so far after using the Macro recorder:

Sub Compfinder()
'
' Compfinder Macro
'

'
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Columns("Q:Q").Select
Selection.Copy
Workbooks.Add
Columns("A:A").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Geo Location"
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Columns("K:K").Select
Selection.Copy
Windows("Book1").Activate
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, transpose:=False
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Windows("Book1").Activate
Windows("CompFinder Tool_Protected_final_11.25.13.xlsm").Activate
Columns("L:L").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
    "C:\Users\raysharm\Documents\Compfinder columns.csv", FileFormat:=xlCSV, _
    CreateBackup:=False
End Sub

When running the macro, I end up getting a bug error for Windows("Book1").Activate , and I imagine I will for the other cut and pastes in the code.

Is there a way so that every time the macro is run, a brand new workbook is created with the respective desired columns to be copy and pasted? What should I put instead of "Book1"?

Thanks, Ray

Answer 1

Activate & Select are common problems in code. Here is a great reference on how to avoid using them.

Here is an example of how to add a new workbook and set it to a variable so that you can easily get a reference to it later in code:

Sub CreateWBandCopy()
    ' Link variable to source workbook
    Dim wbSource As Workbook
    Set wbSource = Workbooks("book1")

    ' Copy Column L from source book
    wbSource.Sheets(1).Range("L:L").Copy

    ' Create new workbook and assign to variable
    Dim wb As Workbook
    Set wb = Workbooks.Add

    ' Link sheet1 to variable  -can also use name like this: Sheets("Sheet1")
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)

    ' Link Specific range to variable
    Dim rng As Range
    Set rng = ws.Columns("A:A")

    ' Paste source col L to new book col A
    rng.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Notice that the code is easy to track what is being done. You don't have to keep track of what book or sheet or cell is currently active.

---

I'm not entirely sure about the logic of your code but here is my best guess on how to correct your references. Note that I used a couple different techniques for referencing & setting ranges. I wasn't trying to confuse the code but show different ways to do the same thing.

Also, I used a few active statements because I'm not sure what your source book name is.

Sub Compfinder()
'
' Compfinder Macro
'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10

    Dim wbSource As Workbook
    Set wbSource = ActiveWorkbook

    Dim wsSource As Worksheet
    Set wsSource = wbSource.ActiveSheet

    Dim rngQ As Range
    Set rngQ = wsSource.Columns("Q:Q")

    rngQ.Copy

    '''''''''''''''''''''''''

    Dim wbNew As Workbook
    Set wbNew = Workbooks.Add

    Dim wsNew As Worksheet
    Set wsNew = wbNew.Sheets(1)

    Dim rng As Range
    Set rng = wsNew.Columns("A:A")

    rng.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    '''''''''''''''''''''''''

    Application.CutCopyMode = False

    wsNew.Range("A1").FormulaR1C1 = "Geo Location"

    wsSource.Columns("K:K").Copy

    wsNew.Columns("B:B").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    wsSource.Columns("L:L").Copy

    wsNew.Columns("C:C").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    wbNew.Activate
    ActiveWorkbook.SaveAs Filename:="C:\Users\raysharm\Documents\Compfinder columns.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub

With the exception of the last save (to your path) I tested that the code runs without errors.