Trying to Copy Multiple Columns from one workbook to another one

[Whiskerbizcuit]

Hey Everyone!

So I'm working on a project to help me out at work. I'm fairly new to VBA so sorry if I sound dumb :P I'm making a macro to copy some raw data from WB1.xlsx to WB2.xlsm The code below is what I'm working with so far, and it works fine, but I need the ranges of the columns to be variable because the data changes from week to week and The columns are never the same length. Any help you can give me would be greatly appreciated. Thanks For Listening!

Sub CopyPasteData()
Dim wb As Workbook
Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

filePath = "d:\xxxx\xxx\xxxx\xxx.xlsx"
Set wb = Application.Workbooks.Open(filePath)

wb.ActiveSheet.Range("A2:A208").Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("A4")

wb.ActiveSheet.Range("B2:B208").Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("B4")

wb.ActiveSheet.Range("C2:C208").Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("C4")

wb.ActiveSheet.Range("D2:D208").Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("E4")

wb.ActiveSheet.Range("E2:E208").Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("F4")
wb.Close False
Set wb = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

 

[Fluff]

Hi & welcome to MrExcel
Untested but try

Sub CopyPasteData()

    Dim wb As Workbook
    Dim UsdRws As Long
    
Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False


    filePath = "d:\xxxx\xxx\xxxx\xxx.xlsx"
    Set wb = Application.Workbooks.Open(filePath)
    UsdRws = Cells.Find("*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    wb.ActiveSheet.Range("A2:C" & UsdRws).Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("A4")
    wb.ActiveSheet.Range("D2:E" & UsdRws).Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("E4")
    wb.Close False
    Set wb = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

 

[cjms85]

There's a couple of things you could try doing.

You could specify the entire columns you want to select:

[FONT=&quot]Columns(1).Select

[/FONT]Would select Column A. Changing the 1 to a 2 or 3 would select column B or C etc.

Alternatively, if there are no blank rows in your columns, that is if every row until the last row in a column contains a value then you could use the [FONT=&quot]xldown[/FONT] function. There's an explanation here:
http://www.excel-easy.com/vba/examples/from-active-cell-to-last-entry.html

 

[Whiskerbizcuit]

Wow, that was fast!! Okay I tried the code but I get an Runtime error '9' script out of range on this line

wb.ActiveSheet.Range("A2:C" & UsdRws).Copy Destination:=ThisWorkbook.Worksheets(2).Columns.Range("A4")

 

[Whiskerbizcuit]

Thanks for the Welcome Fluff!

 

[Whiskerbizcuit]

Thanks for the Link cjms85! I will be giving it a good read!!

 

[NickAtNight]

Did you try the Macro Recorder as a first step?

You said you want to select columns A to F in WB1 and copy and paste them into WB2.

So with the Macro Recorder on, we get this code:

Sub Macro1()
'
' Macro1 Macro
'
'
Columns("A:F").Select
Selection.Copy
Windows("WB2.xlsx").Activate
ActiveSheet.Paste
Windows("WB1.xlsx").Activate
End Sub

alternatively, I toggled the 'Use Relative References' switch and got this code.

'
' Macro2 Macro
'
'
ActiveCell.Columns("A:F").EntireColumn.Select
Application.CutCopyMode = False
Selection.Copy
Windows("WB2.xlsx").Activate
ActiveSheet.Paste
Windows("WB1.xlsx").Activate
End Sub

 

[Fluff]

Hadn't noticed the .columns in the destination.
Try

Sub CopyPasteData()

    Dim wb As Workbook
    Dim UsdRws As Long
    Dim FilePth As String
    
Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False


    FilePth = "d:\xxxx\xxx\xxxx\xxx.xlsx"
    Set wb = Application.Workbooks.Open(FilePth)
    UsdRws = Cells.Find("*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    wb.ActiveSheet.Range("A2:C" & UsdRws).Copy Destination:=ThisWorkbook.Worksheets(2).Range("A4")
    wb.ActiveSheet.Range("D2:E" & UsdRws).Copy Destination:=ThisWorkbook.Worksheets(2).Range("E4")
    wb.Close False
    Set wb = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

 

[NickAtNight]

Now if you want to copy just the cells with information in them, lets do the steps to make that macro.

Note: The obvious problem with this code is that if the new set of data is less than the previous set of data, and you paste into a reused WB2, then the extra lines from the previous week will still be in WB2. That doesn't sound like what you like.

Note the neat way to code how to find the end of the data. The problem with this method is if you have any blank lines or columns, then the selection will stop at the blank line or column.

------------------------

Sub Macro3()
'
' Macro3 Macro
'
'
Application.Goto Reference:="R1C1"
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("WB2.xlsx").Activate
Range("C3").Select
Application.Goto Reference:="R1C1"
ActiveSheet.Paste
Windows("WB1.xlsx").Activate
End Sub

 

[Whiskerbizcuit]

Thanks NickAtNight, and Yes I did try it, but I couldn't get the macro recorder to let me open the file path, copy only the parts of the columns with the data and past them into my new workbook, into the template in that workbook, and then close the "raw data" workbook and continue on. The "raw data" WB will only be opened and closed by the macro and then stay there to be copied over later with new "raw data" to begin the process anew. The WB's are not in the same file location. This is a report I have to generate and run weekly. one of MANY lol
But thanks for the post!!