Originally Posted by Auric__

KeriM wrote:

Auric__;1603700 Wrote:
KeriM wrote:

I have a two part question. I've searched around, but haven't had any
luck finding an answer.

I need to copy certain columns by header since the columns are not
always in the same place. For example, I have a sheet with columns
labeled "1-5" and I need to copy columns 1-3, and 5.

The second part is that I don't want to copy the whole column, just up
to the last cell of data. I've had luck with xldown/xlup, however,
this
data is non-contiguous, so there are blank cells mixed-in which will
render these commands useless.

Any help is greatly appreciated. Thanks! Unfortunately, I can't
provide
any sample spreadsheet data as this is sensitive information. I hope I
explained myself well enough. Thank you!-

Something like this, perhaps?

Sub selectiveCopy()
Dim bottom As Range, headerRow As Range, cell As Range
Set headerRow = Range("A:A")

Note that this should've been:
Set headerRow = Range("1:1")

(Fixed in the code below.)

[snip]

That works great! The only problem I'm running into is the pasting. I
need to paste it all in a new workbook and when I try to dump the copy
into the new workbook, it overwrites the previously pasted column. I
tried designating destination columns, but that means a new line of code
for each copied/pasted column (plus I'm having trouble getting back into
the loop to copy the next section). Is there anyway to select all the
required columns and then copy/paste that entire selection?

I would just move over 1 column with each paste operation. Try this (not
thoroughly tested, but gives the appearance of working):

Sub selectiveCopy()
Dim bottom As Range, headerRow As Range, cell As Range
Dim targetCell As Range, targetSheet As Worksheet
Set headerRow = ActiveSheet.Range("1:1")
Set targetSheet = Workbooks.Add.Sheets(1)
Set targetCell = targetSheet.Cells(1, 1)
For Each cell In headerRow
Select Case cell.Value
Case "value1 to copy", "value2 to copy", "value3 to copy"
Set bottom = Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, _
cell.Column)
If bottom.Value < "" Then
Range(cell.Address & ":" & bottom.Address).Copy
Else
Range(cell.Address & ":" & Cells(bottom.End(xlUp).Row, _
cell.Column).Address).Copy
End If
targetSheet.Paste Destination:=targetCell
'here is where we move over
Set targetCell = targetCell.Offset(0, 1)
targetSheet.Paste Destination:=targetCell
End Select
Next
End Sub

--
Vegetarians will be the first to go. That's my plan.
Vegans haven't got a hope. 'I eat air, I'm so healthy...' ********!