select and move columns by their name in header row

[clsnyder]

Hi

I get a large ws with 70 - 100 cols each month. There is a header row, but
the names of the cols are not always in the same order.

I want to select 3 or 4 entire columns, and move them to a blank sheet in
the same workbook "mdata". This code doesn't work in MS Excel 2007, but I
can't figure out how to correct it.

Sub cleanup()
Sheets("cases-dump").Select
date = WorksheetFunction.Match("Procedure Date", Rows("1:1"), 0)
icd9 = WorksheetFunction.Match("Pre-op Diagnoses 1", Rows("1:1"), 0)
cpt1 = WorksheetFunction.Match("Procedures 1", Rows("1:1"), 0)


Sheets("cases-dump").Columns(date).Copy
Destination:=Sheets("mdata").Range("A1")
Sheets("cases-dump").Columns(icd9).Copy
Destination:=Sheets("mdata").Range("B1")
Sheets("cases-dump").Columns(cpt1).Copy
Destination:=Sheets("mdata").Range("C1")

End Sub

Thanks in advance!

 

[Fred]

I think you need to make the source and destination ranges the same size.
Your Destination should be Sheets("mdata").Columns("A:A")

Good luck
Fred

 

[John_John]

Try this code below:

Sub CleanUp()
On Error Resume Next
With Sheets("cases-dump").Range("1:1")
.Find("Procedure Date").EntireColumn.Copy _
Sheets("mdata").Range("A1")
.Find("Pre-op Diagnoses 1").EntireColumn.Copy _
Sheets("mdata").Range("B1")
.Find("Pre-op Diagnoses 1").EntireColumn.Copy _
Sheets("mdata").Range("C1")
End With
End Sub

I hope it helps you...

Ο χÏήστης "clsnyder" έγγÏαψε: