How to get multiple column data in single column

Hi,
I have been trying to get this puzzle solved but to no avail.....I have got two spreadsheets...I want to get A/C Key in sheet 1 from sheet 2 based on CSI (unique) no. and also if there is no A/C key than I want to bring all the A/C keys assigned to the respective account (lookup by first three numbers- in this case 502) in a single column against that account. I have attached a scenario underneath... Thanks
Sheet 1
CSI A/C KEY
102300 320ONE0
202300 320TWO0
302300 320THREE0
402300 320FOUR0
502
502301 320FIVE1
502302 320FIVE2
502303 320FIVE3

Sheet 2
CORP A/C KEY
102300 320ONE0
202300 320TWO0
302300 320THREE0
402300 320FOUR0
502
502301 320FIVE1
502302 320FIVE2
502303 320FIVE3

RESULT SET THAT I WANT IS
SHEET 1

CSI A/C KEY
102300 320ONE0
202300 320TWO0
302300 320THREE0
402300 320FOUR0
502 320FIVE1
320FIVE2
320FIVE3
502301 320FIVE1
502302 320FIVE2
502303 320FIVE3

Originally Posted by raj0070

Hi,
I have been trying to get this puzzle solved but to no avail.....I have got two spreadsheets...I want to get A/C Key in sheet 1 from sheet 2 based on CSI (unique) no. and also if there is no A/C key than I want to bring all the A/C keys assigned to the respective account (lookup by first three numbers- in this case 502) in a single column against that account. I have attached a scenario underneath... Thanks

It is very difficult to see if I have this right as the formatting of your test data is missing, however the macro below should be a pretty close match to what you're after.

Sub CollateData()
    
    FirstSheetName = ActiveSheet.Name
    ThirdSheetName = "Sheet3"
    FirstSheetRow = 2
    ThirdSheetRow = 2

    Range("A2").Activate
    Do Until ActiveCell = ""
        If ActiveCell.Offset(0, 1) <> "" Then
            Corp = ActiveCell
            AC = ActiveCell.Offset(0, 1)
            KeyVal = ActiveCell.Offset(0, 2)
            Sheets(ThirdSheetName).Activate
            Range("A" & ThirdSheetRow) = Corp
            Range("B" & ThirdSheetRow) = AC
            Range("C" & ThirdSheetRow) = KeyVal
            ThirdSheetRow = ThirdSheetRow + 1
            Sheets(FirstSheetName).Activate
        Else
            Corp = ActiveCell
            Range("A2").Activate
            Do Until ActiveCell = ""
                If Len(ActiveCell) > 3 And Val(Left(ActiveCell, 3)) = Corp Then
                    AC = ActiveCell.Offset(0, 1)
                    KeyVal = ActiveCell.Offset(0, 2)
                    Sheets(ThirdSheetName).Activate
                    Range("A" & ThirdSheetRow) = Corp
                    Range("B" & ThirdSheetRow) = AC
                    Range("C" & ThirdSheetRow) = KeyVal
                    ThirdSheetRow = ThirdSheetRow + 1
                    Sheets(FirstSheetName).Activate
                End If
                ActiveCell.Offset(1, 0).Activate
            Loop
            Range("A" & FirstSheetRow).Activate
        End If
        ActiveCell.Offset(1, 0).Activate
        FirstSheetRow = FirstSheetRow + 1
    Loop
End Sub