Sub PreencherColuna1()
    Dim ultimaLinha As Long
    Dim linhaAtual As Long
    Dim palavras() As String
    Dim abreviacao As String
    
    ' Define a última linha com dados na coluna 2 (B)
    ultimaLinha = Cells(Rows.Count, 2).End(xlUp).Row
    
    ' Percorre cada linha da coluna 2
    For linhaAtual = 1 To ultimaLinha
        ' Verifica se a célula da coluna 1 está vazia
        If Cells(linhaAtual, 1).Value = "" Then
            ' Divide o conteúdo da célula na coluna 2 em palavras
            palavras = Split(Cells(linhaAtual, 2).Value, " ")
            
            ' Limpa a abreviação para cada linha
            abreviacao = ""
            
            Select Case UBound(palavras)
                Case 0 ' Uma palavra
                    abreviacao = Left(palavras(0), 4)
                Case 1 ' Duas palavras
                    abreviacao = Left(palavras(0), 2) & Left(palavras(1), 2)
                Case 2 ' Três palavras
                    abreviacao = Left(palavras(0), 1) & Left(palavras(1), 1) & Left(palavras(2), 2)
                Case Else ' Quatro ou mais palavras
                    abreviacao = Left(palavras(0), 1) & Left(palavras(1), 1) & Left(palavras(2), 1) & Left(palavras(3), 1)
            End Select
            
            ' Preenche a coluna 1 com a abreviação
            Cells(linhaAtual, 1).Value = UCase(abreviacao)
        End If
    Next linhaAtual
End Sub