macro copy/paste lists data from multiple sheets to one comparison sheet

I have a workbook that uses multiple sheets. I am trying to make one sheet that compares the different data.
On the sheet that compares the different data I was wanting to create a macro that once you click a field in the combo box the relative data pops up on the screen. I also want the macro to auto matically line the data up side by dside
I have been successful with this macro (with the help of this forum) to pull data from a single page. However, I need this macro to work for all of the pages in my workbook.

Here is the macro that I used to make the combo box work for pulling data from a single work sheet

Sub DropDown2_Change()
    
    Const FirstCell As String = "B1"
    
    Dim rngDest As Range: Set rngDest = ActiveSheet.Range(FirstCell)
    Dim ddn_Code As DropDown
    Dim rngCodes As Range
    Dim ChosenCode As String
    Dim rngFound As Range
    
    Set ddn_Code = ActiveSheet.DropDowns(Application.Caller)
    Set rngCodes = Sheets("Sheet1").Range("B1", Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft))
    ChosenCode = ddn_Code.List(ddn_Code.Value)
    
    Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
    If rngFound Is Nothing Then Exit Sub
    Set rngFound = rngFound.Offset(1, 0).Resize(rngFound.CurrentRegion.Rows.Count - 1, 1)
    
    If rngDest.Value = vbNullString Then
        rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
    Else
        Set rngDest = ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
        rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
    End If
    
End Sub

And here is the code that didnt work when pulling from multiple sheets.

  Sub DropDown2_Change()
    
    Const FirstCell As String = "B1"
    
    Dim rngDest As Range: Set rngDest = ActiveSheet.Range(FirstCell)
    Dim ddn_Code As DropDown
    Dim rngCodes As Range
    Dim ChosenCode As String
    Dim rngFound As Range
    
    Set ddn_Code = ActiveSheet.DropDowns(Application.Caller)
    Set rngCodes = Sheets("Total Annual").Range("B1", Sheets("Total Annual").Cells(1, Columns.Count).End(xlToLeft))
    Set rngCodes = Sheets("LH Annual").Range("B1", Sheets("LH Annual").Cells(1, Columns.Count).End(xlToLeft))
    Set rngCodes = Sheets("PC Annual").Range("B1", Sheets("PC Annual").Cells(1, Columns.Count).End(xlToLeft))
    Set rngCodes = Sheets("Reinsurance").Range("B1", Sheets("Reinsurance").Cells(1, Columns.Count).End(xlToLeft))
    Set rngCodes = Sheets("Quarterly AM Best").Range("B1", Sheets("Quarterly AM Best").Cells(1, Columns.Count).End(xlToLeft))
    Set rngCodes = Sheets("Annual AM Best").Range("B1", Sheets("Annual AM Best").Cells(1, Columns.Count).End(xlToLeft))
    ChosenCode = ddn_Code.List(ddn_Code.Value)
    
    Set rngFound = rngCodes.Find(LCase(Trim(ChosenCode)))
    If rngFound Is Nothing Then Exit Sub
    Set rngFound = rngFound.Offset(1, 0).Resize(rngFound.CurrentRegion.Rows.Count - 1, 1)
    
    If rngDest.Value = vbNullString Then
        rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
    Else
        Set rngDest = ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
        rngDest.Resize(rngFound.Rows.Count, 1).Value = rngFound.Value
    End If
    
End Sub

I am also attaching the document that I am trying to run the macro in.

here is a link to my previous thread about the same issue:

http://www.excelforum.com/excel-prog...o-another.html