Macro para Preencher Lacunas e Colar Valores/Fórmulas

Boa noite!!

Segue outra macro básica que pode ajudar no dia-a-dia.

Diversas vezes utilizei uma Tabela Dinâmica para resumir dados de grandes tabelas de maneira prática e rápida. Após reorganizar os dados conforme desejado na Tabela Dinâmica, basta copiar a colar valores na aba e teremos uma nova tabela mais resumida.

Entretanto, este método pode gerar tabelas com lacunas por conta da função de resumir, como no caso da tabela abaixo:

No caso de precisarmos utilizar alguma chave nesta nova tabela ou mesmo criar outra Tabela Dinâmica a partir dela, teremos de preencher manualmente os espaços vazios. Há métodos para se fazer isso, que demandariam algum trabalho, mas neste caso vamos usar a seguinte macro para auxiliar no preenchimento:


Sub Preenche()

'
' Macro para preencher as linhas em branco entre linhas preenchidas,
' copiando o valor das células preenchidas imediatamente acima.
' Selecionar a área a ser preenchida e executar a macro.
'
    Dim rng As Range, str As String
    
    Set rng = ActiveSheet.Range(Selection.Address(False, False)) 'Coleta o "Range" selecionado

    On Error Resume Next 'Ignora possíveis erros
    For k = 1 To rng.Areas.Count 'Percorre todas as áreas selecionadas
        For i = 1 To rng.Areas(k).Columns.Count
            str = ""
            For j = 1 To rng.Areas(k).Rows.Count
                
                '"Varre" verticalmente cada célula das áreas
                'selecionadas, e verifica o conteúdo. Se for diferente
                'de vazio, armazena o conteúdo na variável "str" e preenche
                'as células vazias posteriores com o conteúdo desta variável.
                'O conteúdo de "str" é sobrescrito a cada vez que uma célula
                'com conteúdo diferente de vazio é encontrada.
                
                If rng.Areas(k).Cells(j, i).Value <> "" Then
                    str = rng.Areas(k).Cells(j, i).Value
                Else
                    rng.Areas(k).Cells(j, i).Value = str
                End If

            Next
        Next
    Next

End Sub

Agora, selecionando a tabela conforme a figura abaixo:

E aplicando a macro, teremos a tabela preenchida conforme a figura que segue:

E o preenchimento está pronto!

Colando Valores e/ou Fórmulas

Falando em copiar e colar valores, fiz uma macro para colar valores e uma para colar fórmulas que têm sido de grande utilidade. Configurei os atalhos como Ctrl + Shift + V (colar valores) e Ctrl + F (colar fórmulas). Assim fica bem mais rápido colar os valores e/ou fórmulas quando desejado. As macros são bem simples, conforme abaixo:


Sub Colar_Valores()
'
' Cola valores
'
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub


Sub Colar_Fórmulas()
'
' Cola Fórmulas
'
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub


Bom, chega ao fim mais um post. Espero que seja útil, leitor!
Dúvidas e/ou sugestões, escrevam para: guiamacroexcel@gmail.com.

Obrigado e até a próxima!