VBA Excel - Copiando os valores de uma planilha para outra - VBA to loop through cells with date in worksheet 1, extract to worksheet 2 if month and year match

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

Sim, é básico, mas satisfaz ao menos experientes.

No código abaixo aprenderemos como usar o looping num range de células, extraindo deste os resultados desejados, transferindo-os a outra planilha.

Exemplo:

Tenho uma lista começando com uma data na primeira planilha e quero percorrê-la verificando se o mês e o ano da data na primeira coluna da lista, combinam com o mês e o ano da segunda planilha. Se assim for, a informação no resto da linha da data correspondente deve ser copiada para trabalho 2.

Há um download da planilha com alguns dados de exemplo aqui.

Esta rotina fará o que é solicitado acima. Substituirá qualquer informação que esteja na Sheet2 com a informação da tabela da Sheet1. 

É possível ajustar qual dos dados são transferidos para as colunas alterando as variáveis ​​no início.

Sub ProcessRangeData()

    Dim wsSource As Worksheet

    Dim wsDestination As Worksheet

    Dim rowSourceStart As Long

    Dim colSourceDate As Long

    Dim rSource As Long

    Dim colDestStart As Long

    Dim rowDestMonthYear As Long

    Dim cDest As Long

    Dim destBlankColumnCount As Integer

    Dim colDestRegion As Integer

    Dim colDestAccountName As Integer

    Dim colDestPotentialName As Integer

    Dim colDestAmount As Integer

    Dim colDestWeightedAmount As Integer

    Dim colSourceRegion As Integer

    Dim colSourceAccountName As Integer

    Dim colSourcePotentialName As Integer

    Dim colSourceAmount As Integer

    Dim colSourceWeightedAmount As Integer

    Set wsSource = Sheet1

    Set wsDestination = Sheet2

    'Destination column offsets from month column

    colDestRegion = 0

    colDestAccountName = 1

    colDestPotentialName = 2

    colDestAmount = 3

    colDestWeightedAmount = 4

    'Source columns

    colSourceRegion = 5

    colSourceAccountName = 3

    colSourcePotentialName = 4

    colSourceAmount = 6

    colSourceWeightedAmount = 7

    colSourceDate = 2 'Source column for date

    rowSourceStart = 3 'Source starting row

    rowDestMonthYear = 2 'Destination row to check for month & year matching

    rSource = rowSourceStart

    'loop until the date field on the source sheet is blank

    Do While wsSource.Cells(rSource, colSourceDate).Value <> ""

        cDest = 1

        destBlankColumnCount = 0

        'loop through the destination columns until we've seen 5 blanks 

        '(only 3 are ever expected)

        Do Until destBlankColumnCount > 5

            If wsDestination.Cells(rowDestMonthYear, cDest).Value <> "" Then

                destBlankColumnCount = 0

                'check if month matches

                If Month(wsSource.Cells(rSource, colSourceDate).Value) = wsDestination.Cells(rowDestMonthYear, cDest).Value Then

                    'check if year matches

                    If Year(wsSource.Cells(rSource, colSourceDate).Value) = wsDestination.Cells(rowDestMonthYear, (cDest + 1)).Value Then

                        'copy field data

                        wsDestination.Cells((rowDestMonthYear + 2), (cDest + colDestAccountName)).Value = wsSource.Cells(rSource, colSourceAccountName).Value

                        wsDestination.Cells((rowDestMonthYear + 2), (cDest + colDestPotentialName)).Value = wsSource.Cells(rSource, colSourcePotentialName).Value

                        wsDestination.Cells((rowDestMonthYear + 2), (cDest + colDestRegion)).Value = wsSource.Cells(rSource, colSourceRegion).Value

                        wsDestination.Cells((rowDestMonthYear + 2), (cDest + colDestAmount)).Value = wsSource.Cells(rSource, colSourceAmount).Value

                        wsDestination.Cells((rowDestMonthYear + 2), (cDest + colDestWeightedAmount)).Value = wsSource.Cells(rSource, colSourceWeightedAmount).Value

                    End If

                End If

            Else

                destBlankColumnCount = destBlankColumnCount + 1

            End If

            cDest = cDest + 1

        Loop

        rSource = rSource + 1

    Loop

End Sub

Tags: Range, Excel, VBA, copy, worksheet,