Sub agregats()
For Each c In Range("B2:B" & [B65000].End(3).Row)
If c.Value = "" Then GoTo bas
If Left(c, 2) = "TW" Then c.Offset(, 1) = "TW": GoTo bas
If Left(c, 2) = "US" Then c.Offset(, 1) = "NA": GoTo bas
If Left(c, 2) = "CA" Then c.Offset(, 1) = "NA": GoTo bas
If Left(c, 2) = "JP" Then c.Offset(, 1) = "JP": GoTo bas
If Left(c, 2) = "HG" Then c.Offset(, 1) = "HG": GoTo bas
If Left(c, 2) = "DE" Then c.Offset(, 1) = "DE": GoTo bas
If Left(c, 2) = "CH" Then c.Offset(, 1) = "CH": GoTo bas
If Left(c, 4) = "00AF" Then c.Offset(, 1) = "00AF": GoTo bas
If Left(c, 4) = "00AP" Then c.Offset(, 1) = "00AP": GoTo bas
If Left(c, 4) = "00AL" Then c.Offset(, 1) = "00AL": GoTo bas
If Left(c, 4) = "00LU" Then c.Offset(, 1) = "00LU": GoTo bas
If Left(c, 4) = "00LY" Then c.Offset(, 1) = "00LY": GoTo bas
If Left(c, 3) = "00R" Then c.Offset(, 1) = "00R": GoTo bas
If Left(c, 3) = "00S" Then c.Offset(, 1) = "00S": GoTo bas
If Left(c, 3) = "00C" Then c.Offset(, 1) = "00C": GoTo bas
If Left(c, 3) = "00G" Then c.Offset(, 1) = "00G": GoTo bas
If IsNumeric(Left(c, 2)) And Not IsNumeric(Mid(c, 3, 1)) Then c.Offset(, 1) = "AT": GoTo bas
If Not IsNumeric(Left(c, 2)) Then c.Offset(, 1) = "ZZ"
If IsNumeric(Left(c, 2)) And Left(c, 2) > 0 Then c.Offset(, 1) = "XX"
bas:
Next
End Sub