Copy/Paste

[Dan R.]

All I'm trying to do is copy Columns A, D, F, G, M, R, T to a new
spreadsheet (1st row to End(xlUp)).

This is how I'm doing it... it works fine, but can someone please show
me a better way?


Sub Test()
Dim Ws As Worksheet
Dim Wb As Workbook
Dim iEnd As Long
Dim iEnd2 As Long, iEnd3 As Long
Dim iEnd4 As Long, iEnd5 As Long
Dim iEnd6 As Long, iEnd7 As Long
Dim iRng As Range
Dim iRng2 As Range, iRng3 As Range
Dim iRng4 As Range, iRng5 As Range
Dim iRng6 As Range, iRng7 As Range

Set Ws = ActiveSheet
Set Wb = Workbooks.Open("C:\file.xls")


iEnd = Ws.Cells(Rows.Count, 1).End(xlUp).Row
Set iRng = Ws.Range(Ws.Cells(3, 1), Ws.Cells(iEnd, 1))

iEnd2 = Ws.Cells(Rows.Count, 4).End(xlUp).Row
Set iRng2 = Ws.Range(Ws.Cells(3, 4), Ws.Cells(iEnd, 4))

iEnd3 = Ws.Cells(Rows.Count, 6).End(xlUp).Row
Set iRng3 = Ws.Range(Ws.Cells(3, 6), Ws.Cells(iEnd, 6))

iEnd4 = Ws.Cells(Rows.Count, 7).End(xlUp).Row
Set iRng4 = Ws.Range(Ws.Cells(3, 7), Ws.Cells(iEnd, 7))

iEnd5 = Ws.Cells(Rows.Count, 13).End(xlUp).Row
Set iRng5 = Ws.Range(Ws.Cells(3, 13), Ws.Cells(iEnd, 13))

iEnd6 = Ws.Cells(Rows.Count, 18).End(xlUp).Row
Set iRng6 = Ws.Range(Ws.Cells(3, 18), Ws.Cells(iEnd, 18))

iEnd7 = Ws.Cells(Rows.Count, 20).End(xlUp).Row
Set iRng7 = Ws.Range(Ws.Cells(3, 20), Ws.Cells(iEnd, 20))


Set y = Wb.Sheets("Sheet1")

With Ws
iRng.Copy y.Cells(1, 1)
iRng2.Copy y.Cells(1, 2)
iRng3.Copy y.Cells(1, 3)
iRng4.Copy y.Cells(1, 4)
iRng5.Copy y.Cells(1, 5)
iRng6.Copy y.Cells(1, 6)
iRng7.Copy y.Cells(1, 7)
End With

End Sub


Thanks,
-- Dan

 

[Guest]

Dan,

Here's one suggestion.

Sub Test()
Dim Ws As Worksheet
Dim Wb As Workbook
Dim vCols As Variant
Dim i As Integer

Set Ws = ActiveSheet
Set Wb = Workbooks.Open("C:\file.xls")
Set y = Wb.Sheets("Sheet1")

vCols = Array("A", "D", "F", "G", "M", "R", "T")
For i = 1 To UBound(vCols)
Ws.Columns(vCols(i)).Copy y.Columns(vCols(i))
Next i

End Sub

 

[Dan R.]

Wow... I knew there was a better way. Well how do I paste the values
into the Wb starting at the first column? I tried this, but for some
reason it skipped over column A.

Sub Test()
Dim Ws As Worksheet
Dim Wb As Workbook
Dim vCols As Variant
Dim i As Integer
Dim x As Integer

Set Ws = ActiveSheet
Set Wb = Workbooks.Open("C:\file.xls")
Set y = Wb.Sheets("Sheet1")

vCols = Array("A", "D", "F", "G", "M", "R", "T")

x = 1

While x <= 7
For i = 1 To UBound(vCols)
Ws.Columns(vCols(i)).Copy y.Columns(x)
x = x + 1
Next i
Wend

End Sub


Thanks Vergel,
-- Dan

 

[Guest]

Dan,

I forgot that arrays are 0 based by default. So, try it like this:

Sub Test()
Dim Ws As Worksheet
Dim Wb As Workbook
Dim vCols As Variant
Dim i As Integer
Dim y As Worksheet

Set Ws = ActiveSheet
Set Wb = Workbooks.Open("C:\file.xls")
Set y = Wb.Sheets("Sheet1")

vCols = Array("A", "D", "F", "G", "M", "R", "T")

For i = 0 To UBound(vCols)
Ws.Columns(vCols(i)).Copy y.Columns(i + 1)
Next i

End Sub

Here's another way to do this. This one forms a union of all columns to be
copied first and then does the copy one time at the end.

Sub Test2()
Dim Ws As Worksheet
Dim Wb As Workbook
Dim vCols As Variant
Dim i As Integer
Dim y As Worksheet
Dim rCopy As Range

Set Ws = ActiveSheet
Set Wb = Workbooks.Open("C:\file.xls")
Set y = Wb.Sheets("Sheet1")

vCols = Array("D", "F", "G", "M", "R", "T")
Set rCopy = Ws.Columns("A")

For i = 0 To UBound(vCols)
Set rCopy = Application.Union(rCopy, Ws.Columns(vCols(i)))
Next i
rCopy.Copy y.Columns("A")

End Sub

 

[Dan R.]

Perfect! Thanks Vergel.

-- Dan