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

[KeriM]

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

I need to copy certain columns by header since the columns are no
always in the same place. For example, I have a sheet with column
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 u
to the last cell of data. I've had luck with xldown/xlup, however, thi
data is non-contiguous, so there are blank cells mixed-in which wil
render these commands useless.

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

 

[Auric__]

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

 

[KeriM]

KeriM wrote:
-

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

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

 

[Auric__]

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

 

[KeriM]

KeriM wrote:
-

Auric__;1603700 Wrote: - ---
this--- ---
provide---

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 th copy
into the new workbook, it overwrites the previously pasted column. I
tried designating destination columns, but that means a new line o code
for each copied/pasted column (plus I'm having trouble getting bac 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 (no

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

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

 

[Auric__]

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.)

 

[KeriM]

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 new
line of code for each copied/pasted column (plus I'm havin trouble
getting back into the loop to copy the next section). Is ther 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 dat 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 wa copying/pasting
blank cells. The only other problem i have is that it' 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.Past
Destination:=targetCell", the
one right above "End Select". (That was from my testing; forgot t
remove
it.)

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

 

[KeriM]

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 new
line of code for each copied/pasted column (plus I'm havin trouble
getting back into the loop to copy the next section). Is ther 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 dat 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 wa copying/pasting
blank cells. The only other problem i have is that it' 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.Past
Destination:=targetCell", the
one right above "End Select". (That was from my testing; forgot t
remove
it.)

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

 

[Auric__]

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.