need help in copiyng the "entire coloum" macro.

[shiva_reshs]

Hello,

Cells.Find(What:="Invoce Amount", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

I have a pivot table with lots of header in it. I copy selected column based on its header from Pivot and copy in another sheet. I created this macro which search the header but i am not able to copy the entire column. I need help to create a macro which can search the header and copy the column value.

For Example, if column A3 has "Invoice Amount", then I need macro to search Invoice amount and copy the below the entire row from below. (I do not want to copy the header, just a cell value from below header till row 30.

Regards,
Shiva

[AlphaFrog]

Try this. Change the destination to suit.

Sub Copy_Invoce_Amount()
    Dim Found As Range
    Set Found = Cells.Find(What:="Invoce Amount", LookIn:=xlFormulas, LookAt:=xlPart, _
                           SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                           SearchFormat:=False)
    If Not Found Is Nothing Then
        Range(Found.Offset(1), Cells(30, Found.Column)).Copy
        'Paste destination
        Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    Else
        MsgBox "Cannot find 'Invoce Amount'. ", , "Header Not Found"
    End If
End Sub

[shiva_reshs]

Hi Alpha,

Code does the perfect job , But could you help me here to modify the "paste destination"?

With Sheets("Summary - qtr").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats

The code above, helps to search the blank row and paste it, when it paste the data in "Summary - Qtr". Any help on this plz

Regards,
Shiva

[shiva_reshs]

I was able to do it with below code

  Dim Found6 As Range
    Set Found6 = Cells.Find(What:="Invoice Amount", LookIn:=xlFormulas, LookAt:=xlPart, _
                           SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                           SearchFormat:=False)
           If Not Found6 Is Nothing Then
          Range(Found6.Offset(1), Cells(30, Found6.Column)).Copy
          Else
        MsgBox "Cannot find 'Invoce Amount'. ", , "Header Not Found"
    End If
        Sheets("Summary - Qtr").Select
    With Sheets("Summary - qtr").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    
    End With

However, how can I make it Exact search? I mean to say, when it search for Invoice amount , I want Excel to search the exact word, and not a matching word in some other sentence.
Regards,

[AlphaFrog]

    Dim Found6 As Range
    Set Found6 = Cells.Find(What:="Invoice Amount", LookIn:=xlFormulas, LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                            SearchFormat:=False)
    If Not Found6 Is Nothing Then
        Range(Found6.Offset(1), Cells(30, Found6.Column)).Copy
        'Sheets("Summary - Qtr").Select
        With Sheets("Summary - qtr").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
    Else
        MsgBox "Cannot find 'Invoce Amount'. ", , "Header Not Found"
    End If

[shiva_reshs]

Thanks, It worked.

Any help on how Can I have only value to be pasted instead of Formula or formats from Pivot Table?

I have added few columns with formula in it, next to Pivot table. When it searches the "invoices amount" and copy the entire row, it also copy the "#DIV/0!" (if any found) in the Summary - qtr sheet. I found below code, but does not seems to work. It still copy the #DIV/0! in summary sheet.

Worksheets("Raw Pivot").Activate
Range("A4").Select
      Dim Found6 As Range
    Set Found6 = Cells.Find(What:="Invoice Amount", LookIn:=xlFormulas, LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                            SearchFormat:=False)
    If Not Found6 Is Nothing Then
        Range(Found6.Offset(1), Cells(30, Found6.Column)).Copy
        'Sheets("Summary - Qtr").Select
        With Sheets("Summary - qtr").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
            .PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
    Else
        MsgBox "Cannot find 'Invoce Amount'. ", , "Header Not Found"
    End If
    End Sub

[AlphaFrog]

    With Sheets("Summary - qtr").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
        .PasteSpecial Paste:=xlPasteValues
        .Parent.Cells.Replace "#DIV/0!", ""
    End With

[shiva_reshs]

Perfect!!!! Thank you so much for your help!!!!

Regards,
Shiva