Need to copy one worksheet to another based on header info that includes blank cells

Question

I'm trying to copy specific columns from one worksheet to another worksheet to make it uniform so I can easily sort and slice the data in other worksheets. I'm having trouble with some columns copying the entire column including blanks. I am searching the header for specific phrases, selecting the entire column (except the header), and copy/pasting to the other worksheet. The problem arises when I get to a column that has blanks - the xlDown feature stops at the blank cell, but if I use xlCellTypeLastCell it selects all of the columns to the right of the column that I want to copy, so I end up overwriting other cells in my other worksheet. Here is a sample of the code I'm using:

    ' Copy Potential Name

Cells.Find(What:="Potential* Name", After:=ActiveCell, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
Range(Selection.Offset(1, 0), Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Copy
Sheets("Formatted Sheet").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Sheet5").Select
Application.CutCopyMode = False

If I try using a LastRow function; e.g.

LastRow = Sheets("Sheet5").UsedRange.Rows.Count

I can't get it to select the column - it returns an error when I use

Range(Selection.Offset(1, 0), LastRow).Select

Please help!

Thanks in advance

Are the header of the columns at the same row? if so what row? When searching for the header, do you use partial match, or do you know the entire cell value of the header? — EEM

Tim Williams Tim Williams · Accepted Answer · 2016-10-27T21:54:45

Safer to use End(xlUp) from the bottom of the sheet:

Dim f As Range, rng As Range

Set f = Cells.Find(What:="Potential* Name", After:=ActiveCell, LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False)

If Not f Is Nothing Then

    With f.Parent
        Set rng = .Range(f.Offset(1, 0), .Cells(.Rows.Count, f.Column).End(xlUp))
    End With

    rng.Copy
    Sheets("Formatted Sheet").Range("B2").PasteSpecial Paste:=xlPasteValues, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else

    MsgBox "header not found!"

End If

Sheets("Sheet5").Select
Application.CutCopyMode = False

Need to copy one worksheet to another based on header info that includes blank cells

1 Answers