Sub carlmon()
Dim D As Range
Dim E As Range
Dim F As Range
Dim G As Range



    For Each c In Sheet1.Range("B6:B1000")
    
        Set D = Sheet1.Range("D" & Rows.Count).End(xlUp)
        Set E = Sheet1.Range("E" & Rows.Count).End(xlUp)
        Set F = Sheet1.Range("F" & Rows.Count).End(xlUp)
        Set G = Sheet1.Range("G" & Rows.Count).End(xlUp)
        
        Select Case Left(c, 2)
        Case Is = "AB"
            Set D = D.Offset(1)
            D = c.Value
        Case Is = "BC"
            Set E = E.Offset(1)
            E = c.Value
        Case Is = "CD"
            Set F = F.Offset(1)
            F = c.Value
        Case Is = "DE"
            Set G = G.Offset(1)
            G = c.Value
        End Select
    Next c

End Sub