Fix data in sheets from Master sheet

[farrukh]

Hi Experts !
I have one Master data sheet containing all data reside there. I want to fixed the data( certain columns data) into different columns of sheets ( Method1,Method2,Method3,Method4 so on) based on the name of the sheets.
the template is attached .

[Mumps1]

Try the attached file. I've made a few changes to your master sheet to unmerge the merged cells. You should avoid merging cells at all cost because they almost always cause problems for Excel macros. Click the button on the master sheet.

[vcoolio]

Hello Farrukh,

Even though that Mumps has solved this for you, here's another option seeing that I've done the work on it. Its just a slightly different method to Mump's but for the same result. I did the same as Mumps with the merged cells and I also deleted the empty row4 just to tidy up the MasterData sheet a little.

Sub NotSure()

        Dim ws As Worksheet, sh As Worksheet
        Dim x As Long, lr As Long, nRow As Long
        Dim cAr As Variant, pAr As Variant, ar As Variant
     
Application.ScreenUpdating = False

Set sh = Sheets("MasterData")
        lr = sh.Range("A" & Rows.Count).End(xlUp).Row
        ar = Array("Method1", "Method2", "Method3", "Method4", "Method5", "Method6")
        cAr = Array("A4:A" & lr, "B4:B" & lr, "Q4:Q" & lr, "U4:U" & lr, "W4:W" & lr, "AB4:AB" & lr)
        pAr = Array("B", "A", "D", "E", "G", "I")

For i = 0 To UBound(ar)
        sh.Range("A3:AE" & lr).AutoFilter 2, ar(i)
        Set ws = Sheets(ar(i))
        ws.[A3].CurrentRegion.Offset(1).ClearContents
For x = LBound(cAr) To UBound(cAr)
        nRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sh.Range(cAr(x)).Copy
        ws.Range(pAr(x) & nRow).End(3)(2).PasteSpecial xlValues
        ws.Columns.AutoFit
Next x
        sh.[B3].AutoFilter
        ws.Range("A4", ws.Range("I" & ws.Rows.Count).End(xlUp)).Sort ws.[B4], 1
Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

You'll need to ensure that all sheets are created first. Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.

[farrukh]

Hello Gurus Mumps1 /vcoolio
That is wonderful work and help you both saved at least two days for me to copy one by one in respective sheets 90+
only little changes required
@ Mumps1 can it possible the data appear in sorting I mean first old data then new dates ( because i have many sheets to fix the data )? also required to delete the data from template for next use?
@ vcoolio I need to mentioned all the sheets in the array right ?

[Mumps1]

Try the attached file.

[farrukh]

I am sorry ! since all history data reside on master sheet from master sheet not required delete . The sheets method1 ,method2 so on required to clear the cell for next use.
appreciate your efforts

[Mumps1]

Try:

Sub farrukh()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("MasterData")
    Dim LastRow As Long, i As Long, header As Range, rng As Range, RngList As Object, item As Variant
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each rng In srcWS.Range("B5", srcWS.Range("B" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(rng.Value) Then
            RngList.Add rng.Value, Nothing
        End If
    Next rng
    For Each item In RngList
        LastRow = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
        Set desWS = Sheets(item)
        srcWS.Range("A3:AE" & LastRow).AutoFilter Field:=2, Criteria1:=item
        With srcWS.Range("A:A,B:B,Q:Q,U:U,W:W,AB:AB")
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(3).Find(.Areas(i).Cells(3), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(5, x), srcWS.Cells(LastRow, x)).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                    If x > 2 Then
                        srcWS.Range(srcWS.Cells(5, x), srcWS.Cells(LastRow, x)).SpecialCells(xlCellTypeVisible).ClearContents
                    End If
                End If
            Next i
        End With
        LastRow = desWS.Range("B" & desWS.Rows.Count).End(xlUp).Row
        desWS.Sort.SortFields.Clear
        desWS.Sort.SortFields.Add Key:=Range("B4:B" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With desWS.Sort
            .SetRange Range("A3:I" & LastRow)
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        srcWS.Range("A3").AutoFilter
    Next item
    Application.ScreenUpdating = True
End Sub

[farrukh]

bundle of thanks ,God bless you !

[Mumps1]

Thank you and you are very welcome.

[vcoolio]

Good day Farrukh,

@ vcoolio I need to mentioned all the sheets in the array right ?

That is correct.

Cheerio,
vcoolio.

[vcoolio]

By the way Farrukh,

I've just noticed that the sample file didn't attach in my post #3 so, for what its worth, here it is:-

Cheerio,
vcoolio.

[farrukh]

Hi Mumps ,
I am very sorry to bother you . Your code absolutely working 100% . I tried one more thing but not get out I need your help. if in master sheet contains more names (method7,method8 or up to method300 ),so the VBA code by pass the names of Master data sheet(items) and keep only fix the data of sheets which are available in current case method1 to method6 sheet is available.