2
votes

I have a program that needs to copy select columns within the same workbook and worksheet. The current code results in Excel crashing, so I'm not sure if it is working or not.

Is there a better way to copy the columns within the same worksheets with the same workbook?

Code:

Sub Macro1()

Dim wb1 As Workbook

'Set it to be the file location, name, and file extension of the Working File
Set wb1 = Workbooks.Open("Z:\XXX\Working File.xlsx")

MsgBox "Copying Fields within Working File"

wb1.Worksheets(1).Columns("G").Copy wb1.Worksheets(1).Columns("H").Value
wb1.Worksheets(1).Columns("J").Copy wb1.Worksheets(1).Columns("O").Value
wb1.Worksheets(1).Columns("K").Copy wb1.Worksheets(1).Columns("N").Value
wb1.Worksheets(1).Columns("M").Copy wb1.Worksheets(1).Columns("P").Value

wb1.Close SaveChanges:=True

End Sub
1
Take off the .Value at the end. You just want to copy to a range, not Value. But, if you just need values and not formatting/etc, you can just do Range([Destination Range]).Value = Range([copy range]).Value, i.e. wb1.Worksheets(1).Columns("H").Value = wb1.Worksheets(1).Columns("G").Value. Also, do you need to use the whole column?BruceWayne
Ah, I added that because the client wanted to have a paste values only option, and I thought that was how you could do thatDylan F
I do need the whole columnDylan F
It is very rare that you need the whole column, that's 1048576 cells these days, the majority of which will be empty.YowE3K
@DylanF - We can handle that with a simple line or two. If the rows change over time, you just need to get the lastRow for each column. But for now, if it works, it works!BruceWayne

1 Answers

4
votes

Try this, it sets two ranges' values equal, which will keep the data, but no formatting. It should be quicker.

Sub Macro1()
Dim wb1 As Workbook
'Set it to be the file location, name, and file extension of the Working File
Set wb1 = Workbooks.Open("Z:\XXX\Working File.xlsx")

MsgBox "Copying Fields within Working File"

With wb1.Worksheets(1)
    .Columns("H").Value = .Columns("G").Value
    .Columns("O").Value = .Columns("J").Value
    .Columns("N").Value = .Columns("K").Value
    .Columns("P").Value = .Columns("M").Value
End With

wb1.Close SaveChanges:=True

End Sub

Note you're using a whole column, so it might hang up or take a little longer. If you want, you can instead just get the last Row of each column and use that to shorten the ranges being copied.

Edit: As mentioned above, you may be better off using a smaller range. This is a little more verbose, but you should be able to follow what it's doing:

Sub Macro1()
Dim wb1 As Workbook
Dim lastRow As Long
'Set it to be the file location, name, and file extension of the Working File
Set wb1 = ActiveWorkbook

MsgBox "Copying Fields within Working File"

With wb1.Worksheets(1)
    lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
    .Range("H1:H" & lastRow).Value = .Range("G1:G" & lastRow).Value

    lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
    .Range("O1:O" & lastRow).Value = .Range("J1:J" & lastRow).Value

    lastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
    .Range("N1:N" & lastRow).Value = .Range("K1:K" & lastRow).Value

    lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
    .Range("P1:P" & lastRow).Value = .Range("M1:M" & lastRow).Value
End With

wb1.Close SaveChanges:=True

End Sub