VBA Codes to put the one sheet datas from 2 parameters

[PRADEEPB270]

I want to know the VBA codes who put up all datas from a sheet ( all columns and all rows ),to provide the 2 parameters on a "Display Result"sheet.

Request you to please refer my attach file .

If I provide 2 informations i.e.'Month' and 'Sheet Name' on 'Display Result "sheet,then,all the datas should be appear on 'Display Result' sheet.

[HansV]

Try this:

Code: Select all

Sub FilterData()
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Set wshT = Worksheets("Display Result")
    Set wshS = Worksheets(wshT.Range("B2").Value)
    wshT.Range("A1:B1").Copy
    wshT.Range("D1:D2").PasteSpecial Transpose:=True
    wshS.Range(wshS.Range("B4"), wshS.Range("B4").End(xlToRight).End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wshT.Range("D1:D2"), _
        CopyToRange:=wshT.Range(wshT.Range("B4"), wshT.Range("B4").End(xlToRight))
ExitHandler:
    wshT.Range("D1:D2").Clear
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[PRADEEPB270]

Not working.The message is appearing 'The extract range has a missing or illegal field name'.Please look the attach file after put the vba codes.

[HansV]

You removed the headers from the Display Results sheet. Please put them back.

By the way, the code that I posted will only work if all sheets have the same headers.

[PRADEEPB270]

Sir,suppose ,there are so many sheets but the headers are not same.Please rectify the codes according to the sheets and not to the fixed header.Yes,all the sheet will be a fixed header in column 'B'i.e.Month.

[HansV]

Here is a new version:

Code: Select all

Sub FilterData()
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Set wshT = Worksheets("Display Result")
    wshT.Range(wshT.Range("B4"), wshT.Range("B4").End(xlToRight).End(xlDown)).Clear
    Set wshS = Worksheets(wshT.Range("B2").Value)
    With wshS.Range(wshS.Range("B4"), wshS.Range("B4").End(xlToRight).End(xlDown))
        .AutoFilter Field:=1, Criteria1:=wshT.Range("B1").Text
        .Copy Destination:=wshT.Range("B4")
        .AutoFilter
    End With
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[PRADEEPB270]

Perfect working now.Thanks Hans Sir for your nice cooperation with me.I will be greatful to you.

[Rudi]

I've known about the option in Advanced filter to copy the filter range to another location, but I never put 2 and 2 together regarding these arguments in VBA.

Its a nice shortcut to know about to specify the paste location of a filtered range.
TX for bringing this to my attention...I will not quickly forget this option.

Code: Select all

wshS.Range(wshS.Range("B4"), wshS.Range("B4").End(xlToRight).End(xlDown)).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=wshT.Range("D1:D2"), _
        CopyToRange:=wshT.Range(wshT.Range("B4"), wshT.Range("B4").End(xlToRight))

[HansV]

Some things to keep in mind:

1) The CopyToRange can be:
- A range in a single row containing the field names that you want to be copied. You don't have to include all field names from the source range.
or
- An empty range of cells in a single row of the same size as the header row of the source range. It will be filled with the headers.
or
- An empty cell that will act as the top left corner of the copied range. The cells to the right to it should be empty too. All headers from the source range will be used.

2) All cells below the headers in the target range will be cleared before the filtered rows are copied. So any data you had placed there will be lost.

[Rudi]

TX. Very useful.
Cheers