Thread: Need help with a code to add some more information.

Hi I have a code which is given and working fine. Using that code I am getting only 50% information which is required. Please help me editing that script in a way which will give me the output the way I want.
In page 1 the data is in different rows and columns and I have 20 pages like that. I have the data in different rows and columns from page2 to page20. (All the data will be in same rows and columns for all these sheets except page 1). One more thing the below code is only gathering the data for only the below queue name and if there exists another queue name it is not giving the output for the second queue name. So I need is For a name specified if there are 2 queues also i need that information also to be in my output. The same way I need the output from the remaining pages (2,3,4....) to be in the same page. I mean I need finally all the data to be in a single sheet.

The data for a name in page 1 some times will be in page 2 or the same way in the next page also.

I may not be clear to you. So, please have a look at the pages first and also run the macro which is given below to understand first what I am trying to say and help me. I need the output in the same format the one which you will get after running the macro given below. Please some one save me...

Sub Gather_Data()
    Dim vD          As Variant
    Dim x           As Long
    Dim y           As Long
    Dim z           As Long

    'COLLECT DATA
    With Worksheets("Sheet1")
        vD = Intersect(.Columns("F:F"), .UsedRange)
        ReDim Preserve vD(1 To UBound(vD), 1 To 4)

        For x = 1 To UBound(vD)
            If Not IsEmpty(vD(x, 1)) Then
                vD(x, 2) = .Cells(x + 1, 3)
                If .Cells(x + 3, 3) = "Total" Then
                    vD(x, 3) = .Cells(x + 3, 11)
                    vD(x, 4) = .Cells(x + 3, 45)
                Else
                    vD(x, 3) = .Cells(x + 1, 10)
                    vD(x, 4) = .Cells(x + 1, 45)
                End If
            End If
        Next x
    End With

    'POST DATA
    With Worksheets("Sheet2")
        z = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
        For x = 1 To UBound(vD)
            If Not IsEmpty(vD(x, 1)) Then
                For y = 1 To 4
                    .Cells(z, y) = vD(x, y)
                Next y
                z = z + 1
            End If
        Next x
    End With
End Sub

I have given the macro above. That is the macro which i am using now.