titulo.jpg

Home

Principal

Assinar

 

Dicas

Excel

Word

Outlook

Office/VBA

Suplementos

Vídeos

Outros

Busque neste site:

Loading
 

Gerar Planilhas com Base em uma Planilha Padrão e uma Tabela

Última Atualização: 22/06/2012

Introdução

Gerar uma Base de Dados Baseada em Várias Planilhas

Referências

 

Introdução

Suponha que você tem uma Pasta de Trabalho com duas Planilhas. A primeira Planilha, que se chama Lista, possui uma tabela como mostrado abaixo:

A Planilha que chama Modelo possui um formulário padrão, como podemos ver abaixo:

Nosso objetivo é criar uma nova Pasta de Trabalho que tenha um número de Planilhas igual ao número de registros da Planilha Lista. Além disso, cada uma das Planilhas deve estar devidamente povoada com os dados da Planilha Lista.

O código abaixo executa essa rotina:

Sub GeraRelatórios()
    
    'Local onde os valores da Lista são atribuídos na Planilha Modelo
    Const sNome As String = "E5"
    Const sIdade As String = "E7"
    Const sCidade As String = "E11"
    Const sCor As String = "E9"
    
    Dim lLast As Long
    Dim lRow As Long
    Dim wb As Workbook
    Dim wsLista As Worksheet
    Dim ws As Worksheet
    
    Set wsLista = ThisWorkbook.Sheets("Lista")
    
    'Opcional: descomente a linha abaixo para aumentar a velocidade
    'de elaboração dos relatórios:
    'Application.ScreenUpdating = False
    
    With wsLista
        lLast = .Cells(.Rows.Count, "A").End(xlUp).Row
    
        Set wb = Workbooks.Add(xlWBATWorksheet)
        
        'A contagem se inicia em 2 porque a linha 1 é o cabeçalho
        For lRow = 2 To lLast
            'Copia um dos Modelos para a nova Pasta de Trabalho
            ThisWorkbook.Sheets("Modelo").Copy Before:=wb.Sheets(1)
            Set ws = wb.Sheets(1)
            'Renomeia a nova Planilha para, por exemplo, o nome de uma
            'pessoa da Planilha Lista:
            ws.Name = .Cells(lRow, "A")
            'Entra com os registros da tabela em Lista na nova Planilha
            ws.Range(sNome) = .Cells(lRow, "A")
            ws.Range(sIdade) = .Cells(lRow, "B")
            ws.Range(sCidade) = .Cells(lRow, "C")
            ws.Range(sCor) = .Cells(lRow, "D")
        Next lRow
    End With

    'Se você alterou a propriedade ScreenUpdating do objeto Application,
    'deve voltar ao valor que estava antes, que provavelmente era True:
    'Application.ScreenUpdating = True

End Sub

O resultado dessa rotina pode ser visto abaixo, uma nova Pasta de Trabalho com várias Planilhas com nomes correspondentes aos registros da tabela em Lista, devidamente povoadas:

A estratégia adotada foi definir as células onde os valores na Planilha Modelo serão entrados, de cada uma das variáveis (Nome, Idade, Cor e Cidade). Em seguida, uma nova Pasta de Trabalho foi criada e um laço foi percorrido nas linhas da tabela da Planilha Lista.

Para cada iteração nessa tabela, foi copiada uma Planilha Modelo dentro da nova Pasta de Trabalho. Para manter os nomes das Planilhas organizados dentro da nova Pasta de Trabalho, optei por renomeá-las de acordo com o Nome correspondente de cada pessoa. Note que se haver um nome repetido, essa rotina retornará um erro.

 

Gerar uma Base de Dados Baseada em Várias Planilhas

Essa seção mostra como fazer o inverso, isto é: suponha que você tem várias Planilhas numa Pasta de Trabalho e precisa criar uma base de dados para todas as elas.

Para resolver essa questão, usarei o exemplo anterior: partirei da Pasta de Trabalho que foi gerada pela rotina anterior para criar a base de dados.

Vale ressaltar que para esse exemplo funcionar, as Planilhas devem possuir o mesmo padrão. Se os dados de uma Planilha estiverem deslocados uma linha em relação a outra, os dados extraídos estarão incorretos.

Use o código abaixo:

Sub GeraBaseDeDados()
    
    'Endereço dos campos buscados nas Planilhas padrões:
    Const sNome As String = "E5"
    Const sIdade As String = "E7"
    Const sCidade As String = "E11"
    Const sCor As String = "E9"
    
    Dim lRow As Long
    Dim wb As Workbook
    Dim wsResumo As Worksheet
    Dim ws As Worksheet
    
    'Atribui à wsResumo a Planilha de uma nova Pasta de Trabalho criada
    'com apenas uma Planilha:
    Set wsResumo = Workbooks.Add(xlWBATWorksheet).Sheets(1)
    
    'Constrói cabeçalho da base de dados:
    wsResumo.Range("A1:D1") = Array("Nome", "Idade", "Cidade", "Cor")
    
    'A linha 1 é o cabeçalho
    lRow = 2
    
    For Each ws In ThisWorkbook.Worksheets
        wsResumo.Cells(lRow, "A") = ws.Range(sNome)
        wsResumo.Cells(lRow, "B") = ws.Range(sIdade)
        wsResumo.Cells(lRow, "C") = ws.Range(sCidade)
        wsResumo.Cells(lRow, "D") = ws.Range(sCor)
        lRow = lRow + 1
    Next ws
    
    'Redimensiona colunas (opcional):
    wsResumo.Columns.AutoFit

End Sub

O resultado final, ao executar essa macro, é mostrado abaixo:

 

Referências

Para fazer o download de um exemplo (Pasta de Trabalho), clique aqui.

 

---

Site de Felipe Costa Gualberto.

Belo Horizonte, Brasil, 2009-2013.

felipe@ambienteoffice.com.br