PDA

View Full Version : Copy columns



inajica
12-20-2007, 10:35 AM
I like to create a macro to copy columns. I have 100 columns of data in Sheet2. Each column has the same range of data. I want to copy 10 of those columns and paste it into one column in Sheet3. The ten columns that I want to copy will be what is in Sheet1 A1:A10. I would to be in letter reference style. Thank you for any help with this.

xld
12-20-2007, 10:46 AM
You don't say where to copy it to, so I guessed



Public Sub CopyData()
Dim mpCell As Range
Dim i As Long

With Worksheets("Sheet2")

i = 1
For Each mpCell In Worksheets("Sheet1").Range("A1:A10")

If mpCell.Value <> "" Then

i = i + 1
.Cells(1, mpCell.Value).EntireColumn.Copy Worksheets("Sheet1").Cells(1, i)
End If
Next mpCell
End With
End Sub

inajica
12-20-2007, 11:10 AM
Thank you for your quick reply. The code worked great. But is it possible to paste into one Column--like into Sheet1 Column B1.

figment
12-20-2007, 11:57 AM
Public Sub CopyData()
Dim mpCell As Range
Dim i As Long

With Worksheets("Sheet2")

i = 1
For Each mpCell In Worksheets("Sheet1").Range("A1:A10")

If mpCell.Value <> "" Then
.Cells(1, mpCell.Value).Resize(.Cells(1, mpCell.Value).End(xlDown), 1).Copy _
Worksheets("Sheet1").Cells(i, 2)
i = i + .Cells(1, mpCell.Value).End(xlDown).Row
End If
Next
End With
End Sub

xld
12-20-2007, 11:57 AM
Public Sub CopyData()
Dim mpCell As Range
Dim i As Long
Dim mpLast1 As Long
Dim mpLast2 As Long
Dim sh As Worksheet

With Worksheets("Sheet2")

i = 1
mpLast2 = 1
Set sh = Worksheets("Sheet1")
For Each mpCell In sh.Range("A1:A10")

If mpCell.Value <> "" Then

mpLast1 = .Cells(.Rows.Count, mpCell.Value).End(xlUp).Row
.Cells(1, mpCell.Value).Resize(mpLast1).Copy sh.Cells(mpLast2, "B")
mpLast2 = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row + 1
End If
Next mpCell
End With
End Sub