Data extraction from multiple sheets

[Vbalearner85]

Hello... I have the below macro which perfectly splits data for multiple unique values of column A from sheets ("Ddata", "Edata", "Fdata", "Gdata"), and adds new tab for each of the value data.

Need modification so as to pick up the same data (as of below macro) for one of the unique values (below macro is creating for each value of column A- new macro should do only for one value as selected) of column A, and give the result every time in Tab "Result" - pre-existing tab, for column A value selection in cell "Z1" of the same Tab "Result". So every time data should be fetched in Tab "Result" for the value selected in cell "Z1" of Tab "Result" when Macro is run. Also, it should not disturb source data unfiltered/non-modified @ end in source tabs.

Thanks in Advance..below is the macro which needs modification/create new macro as appropriate.

Sub SplitData()
Dim sh As Worksheet, nsh As Worksheet, Rng As Range, ary As Variant
Dim i As Long, lr As Long, c As Range, cel As Range
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
ary = Array("Ddata", "Edata", "Fdata", "Gdata")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            lr = .Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
            If lr > 1 Then
               .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(lr + 3, 2), True
               Set Rng = .Cells(lr + 4, 2).CurrentRegion.Offset(1)
               Rng.Sort .Cells(lr + 4, 2), xlAscending
               Rng.Copy nsh.Cells(Rows.Count, 1).End(xlUp)(2)
               Rng.CurrentRegion.ClearContents
            End If
        End With
    Next
nsh.UsedRange.Sort nsh.Range("A1"), xlAscending
nsh.Columns(1).RemoveDuplicates 1, xlNo
Set Rng = nsh.UsedRange
    For Each c In Rng
        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
        sh.Name = c.Value
        For j = LBound(ary) To UBound(ary)
            With Sheets(ary(j))
                .UsedRange.AutoFilter 1, c.Value
                If sh.Range("A1") = "" Then
                    .UsedRange.Copy sh.Range("A1")
                Else
                    .UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
                .AutoFilterMode = False
            End With
        Next
    Next
Application.DisplayAlerts = False
nsh.Delete
Application.DisplayAlerts = True
End Sub