gpclouro,

Anexe um planilha mostrando como seria o resultado final. Assim fica mais fácil tentar ajudar.

att,

Bruno, obrigado pelo retorno!

Parece que eu consegui com essa macro aqui:

Sub fMain()
    Dim lngBD As Long
    Dim lngLast As Long
    Dim wksBD As Worksheet
    Dim wks As Worksheet
    Dim i As Integer, j As Integer
    
Set wksBD = ThisWorkbook.Sheets("BD")
    With wksBD
        For lngBD = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Set wks = Nothing
            On Error Resume Next
            Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, "A")))
            On Error GoTo 0
            If wks Is Nothing Then
                Set wks = ThisWorkbook.Sheets.Add
                wks.Name = CStr(.Cells(lngBD, "A"))
                wksBD.Rows(1).Copy wks.Rows(1)
            End If
            lngLast = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 1
            wksBD.Rows(lngBD).Copy wks.Rows(lngLast)
        Next lngBD
    End With


  For i = 1 To Sheets.Count
   For j = 1 To Sheets.Count - 1
    If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
     Sheets(j).Move After:=Sheets(j + 1)
    End If
   Next j
  Next i

End Sub