Chiragcoder

 Option Explicit

Sub xyz()

Dim wb As Workbook

Dim ws As Worksheet

Dim ws1 As Worksheet

Dim ws2 As Worksheet

Dim ws3 As Worksheet

Set wb = ThisWorkbook

Set ws = wb.Worksheets("A")

Set ws1 = wb.Worksheets("input")

Set ws3 = wb.Worksheets("Output")

Set ws2 = wb.Worksheets("Z")

ws.Activate

Dim c As Long

Dim l As Long

c = ws.Cells(1, Columns.Count).End(xlToLeft).Column

l = ws.Cells(Rows.Count, 1).End(xlUp).Row

ws.Range(Cells(1, 1), Cells(1, c)).Copy

ws3.Activate

ws3.Range("A1").Select

ws3.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

ws1.Activate

Dim ADV1 As Long

Dim ADV2 As Long

ADV1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

ADV2 = ws1.Cells(Rows.Count, 1).End(xlUp).Row

ws1.Activate

Dim GWS1 As Long

Dim GWS2 As Long

GWS1 = ws1.Cells(2, Columns.Count).End(xlToLeft).Column

GWS2 = ws1.Cells(Rows.Count, 2).End(xlUp).Row

ws3.Activate

Dim c3 As Long

Dim l3 As Long

c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

'Looping"

Dim x As Long

Dim z As Long

Dim xx As Long

Dim xx1 As Long

Dim zz As Long

ws.Activate

For x = 2 To l

    ws.Activate

   

   '--------Check ADV or GWS==============

    If ws.Range("C" & x).Value = "ADV" Or ws.Range("C" & x).Value = "GWS" Then

        If ws.Range("F" & x).Value < 999999 And ws.Range("F" & x).Value > 0 Then

            ws.Range(Cells(x, 1), Cells(x, c)).Copy

            ws3.Activate

            ws3.Range("A" & l3 + 1).Select

            ws3.Range("A" & l3 + 1).PasteSpecial xlPasteValuesAndNumberFormats

            

            

        

            If ws.Range("C" & x).Value = "ADV" Then

            For xx = 2 To ADV2

                    ws3.Activate

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    ws3.Range("A" & l3).EntireRow.Copy

                    ws3.Range("A" & l3 + 1).Select

                    ws3.Range("A" & l3 + 1).PasteSpecial xlPasteAll

                    ws3.Range("A" & l3 + 1).Value = "Child"

                    ws3.Range("C" & l3 + 1).Value = ws1.Range("A" & xx) '----AWS value looping

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    Next xx

            Else

                     For xx = 2 To GWS2

                    ws3.Activate

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    ws3.Range("A" & l3).EntireRow.Copy

                    ws3.Range("A" & l3 + 1).Select

                    ws3.Range("A" & l3 + 1).PasteSpecial xlPasteAll

                    ws3.Range("A" & l3 + 1).Value = "Child"

                    ws3.Range("C" & l3 + 1).Value = ws1.Range("B" & xx) '----GWS value looping

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    Next xx

            End If

            

           

                   

        

    

        

        

      

Else

ws.Range(Cells(x, 1), Cells(x, c)).Copy

            ws3.Activate

            ws3.Range("A" & l3 + 1).Select

            ws3.Range("A" & l3 + 1).PasteSpecial xlPasteValuesAndNumberFormats

            

    

    ws2.Activate

    Dim x1 As Long

    Dim z1 As Long

    Dim x3 As Long

    

    

x1 = ws2.Cells(Rows.Count, 6).End(xlUp).Row

z1 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column

    

c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

 

    Dim xy As Long

    

    For xy = 2 To x1

        If ws2.Range("F" & xy).Value = ws.Range("F" & x).Value Then

            If ws2.Range("C" & xy).Value = ws.Range("C" & x).Value Then

        

        

          Do Until ws2.Range("A" & xy + 1).Value <> "Child"

            If ws2.Range("N" & xy + 1).Value = 1 Then

            

                 If ws.Range("C" & x).Value = "ADV" Then

                 For x3 = 2 To ADV2

                    ws2.Range("A" & xy + 1).EntireRow.Copy

                    ws3.Activate

                    ws3.Range("A" & l3 + 1).Select

                    ws3.Range("A" & l3 + 1).PasteSpecial xlPasteValuesAndNumberFormats

                    ws3.Activate

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    ws3.Range("A" & l3).Value = "Child"

                    ws3.Range("C" & l3).Value = ws1.Range("A" & x3)

                    'ws3.Range("A" & l3).EntireRow.Copy

                    'ws3.Range("A" & l3 + 1).Select

                    'ws3.Range("A" & l3 + 1).PasteSpecial xlPasteAll

                

                Next x3

                 

                 Else

                 

                    For x3 = 2 To GWS2

                    ws2.Range("A" & xy + 1).EntireRow.Copy

                    ws3.Activate

                    ws3.Range("A" & l3 + 1).Select

                    ws3.Range("A" & l3 + 1).PasteSpecial xlPasteValuesAndNumberFormats

                    ws3.Activate

                    c3 = ws3.Cells(1, Columns.Count).End(xlToLeft).Column

                    l3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

                    ws3.Range("A" & l3).Value = "Child"

                    ws3.Range("C" & l3).Value = ws1.Range("B" & x3)

                    'ws3.Range("A" & l3).EntireRow.Copy

                    'ws3.Range("A" & l3 + 1).Select

                    'ws3.Range("A" & l3 + 1).PasteSpecial xlPasteAll

                Next x3

                 

                 

                 End If

                 

            

      

                

                

      

        

        

    

        

        

            

            Else

            End If

            

            

            xy = xy + 1

            Loop

        Else

        End If

        

        Else

        End If

    Next xy

        End If

        Else

    End If

    

Next x

MsgBox "Testing"

End Sub