Copy columns by Header and select all data (non-contiguous) from those columns
 

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!

Copy columns by Header and select all data (non-contiguous) from those columns
 

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")
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
'code here to paste wherever you want it
End Select
Next
End Sub

--
What a totally inappropriate, tasteless and vile comment! I love it!

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?

Copy columns by Header and select all data (non-contiguous) from those columns
 

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...' ********!

Works perfectly. I just had to add a line to activate my data worksheet since the code is written to create the new workbook before the loop, so it takes the new worksheet as the active sheet so it was copying/pasting blank cells. The only other problem i have is that it's copying/pasting the last column twice.

Copy columns by Header and select all data (non-contiguous) from those columns
 

KeriM wrote:

Auric__ Wrote:
KeriM wrote:
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):
[snip]
Works perfectly. I just had to add a line to activate my data worksheet
since the code is written to create the new workbook before the loop, so
it takes the new worksheet as the active sheet so it was copying/pasting
blank cells. The only other problem i have is that it's copying/pasting
the last column twice.

Whoops. At the very end of the sub...

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

....delete the second copy of "targetSheet.Paste Destination:=targetCell", the
one right above "End Select". (That was from my testing; forgot to remove
it.)

--
- What's the winning lottery numbers?
- If I knew that, I wouldn't be working here!

That did it! It works perfectly now. Thank you so much for your help!

Sorry to bother you again about this, but I have one more question. I have to actually run this code on two different sheets and then stack the results onto one sheet. I've figured out the offset for pasting the 2nd set of results under the 1st, but I don't need the headers on the 2nd set of results. Is there a way to modify this code so that the headers are not copied?

Copy columns by Header and select all data (non-contiguous) from those columns
 

KeriM wrote:

Sorry to bother you again about this, but I have one more question. I
have to actually run this code on two different sheets and then stack
the results onto one sheet. I've figured out the offset for pasting the
2nd set of results under the 1st, but I don't need the headers on the
2nd set of results. Is there a way to modify this code so that the
headers are not copied?

For the second sheet (only), where my sub references cell.Address, change it
to cell.Offset(1, 0).Address.

--
What you see can depend on what you look for.

Perfect! Thanks so much for all your help!