Essa macro do Aplicativo Microsoft Excel VBA, contém uma macro que copia dados referente a um determinado intervalo de datas e cola em outra folha de planilha também no mesmo intervalo de datas.


Sub Copiar_dados_para_outra_plan()

Dim vData As String
Dim vColuna As Integer
Dim vEncontrar As Boolean

On Error GoTo Err_Execute

'Retorna o valor da data
vData = Sheets("Planilha Dados").Range("B4").Value

Sheets("Plan").Select

'inicia na coluna(B)
vColuna = 2
vEncontrar = False

While vEncontrar = False

'se encontrar uma célula em branco na linha 2, termina a busca
If Len(Cells(2, vColuna)) = 0 Then
MsgBox "Dados não encontrados.", vbInformation, "http://www.saberexcel.com"
Exit Sub

'dados encontrado após a linha 2
ElseIf Cells(2, vColuna) = vData Then

'Seleciona valor para copiar da "Planilha Dados"
Sheets("Planilha Dados").Select
Range("B5:H6").Select
Selection.Copy

'Cola na "Plan"
Sheets("Plan").Select
Cells(3, vColuna).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

vEncontrar = True
MsgBox "Os dados foram copiados com sucesso!!", vbInformation, "http://www.saberexcel.com"

'continua a procura
Else
vColuna = vColuna + 1
End If

Wend

On Error GoTo 0

Exit Sub

Err_Execute:
MsgBox "Ocorreu um #erro#!", vbInformation, "http://www.saberexcel.com"

End Sub

Aprenda Aplicativo Microsoft Excel VBA - SaberExcel

Saberexcel - site das macros
Essas macros do Aplicativo Microsoft Excel VBA, copiam dados de uma determinada coluna para outra, para células pre-determinadas.
Observem que um assunto também muito importante é aprender a depurar uma macro, vejam a diferença em um código gravado e um código devidamente depurado para tal finalidade. Em outro tutorial pretendo apresentar uma matéria de como inserir um subtotal em grupo de números em uma lista de grupo de numero muito intensa.
Baixe o exemplo de planilha no final da página. Fiquem com Deus, Boa Sorte.
E_Marcondes.

'linha de código depurada
Sub depurando_codigo_gravado()
Plan2.[K1:K23000].Copy Plan1.[C1]
End Sub

'aqui a mesma macro que foi gravada, com algumas linhas de códigos que poderiam muito bem
'serem suprimidas, chamamos isso de depuração de código.
Sub macro_gravada()
Sheets("Plan2").Select
Range("K1:K23000").Select
Selection.Copy
Sheets("Plan1").Select
Range("C1").Select
ActiveSheet.Paste
Range("E1").Select
End Sub

Sub deletar_teste()
[C1:C23000].ClearContents
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Esta macro do Aplicativo Microsoft Excel VBA, contém uma macro que copia os dados de uma determinada planilha para outra planilha, isto é, copia os dados da Planilha ("Lista") para Planilha ("Resumo"). Observem como foi "Setado" (Set) as variáveis com os nomes das folhas de planilhas e os nomes dos intervalos range (para procura da área usada). e abra outra planilha chamada "Resumo". Então:
Abra duas planilhas: "Lista" e "Resumo" a Planilha "Resumo" vai receber o relatório, isto o ítem que voce selecionar e executar a macro.

Option Explicit

Sub Artigo_para_resumo()
'Excel VBA Estudos <Escola de Informática>
Dim VlorDados As Variant
Dim wsPlan As Worksheet, wsResumo As Worksheet
Dim rnPlan As Range, rnResumo As Range, RnDados As Range
Dim lnLinhaAtiva As Long, lnProximaLinha As Long

Set wsPlan = ThisWorkbook.Worksheets("Lista")
Set wsResumo = ThisWorkbook.Worksheets("Resumo")
Set rnPlan = wsPlan.Range("A2", Range("C65536").End(xlUp))

'Verificação de que a célula activa se encontra na barra de espaço
'onde estão as celulas com os dados para serem transferidos.
If Intersect(ActiveCell, rnPlan) Is Nothing Then
MsgBox "Você deve selecionar um item no lista do estoque.", _
vbInformation, "Fora da Area!! <Saberexcel.com>"
Exit Sub
End If

'Recuperando na célula activa número da linha
lnLinhaAtiva = ActiveCell.Row
Set RnDados = wsPlan.Range("A" & lnLinhaAtiva & ":C" & lnLinhaAtiva)

'são os valores das celulas(range)
VlorDados = RnDados.Value

'Identifica a próxima linha vazia na zona da recepção
lnProximaLinha = wsResumo.Range("B65536").End(xlUp).Row + 1

'Transferir os dados desejados
wsResumo.Range("B" & lnProximaLinha & ":D" & lnProximaLinha) = VlorDados
MsgBox "Valores da Linha " & lnLinhaAtiva & " Copiados para planilha Resumo!"

End Sub


Aprenda Aplicativo Microsoft Excel VBA - SaberExcel - o Site das Macros

SaberExcel - o Site das Macros
Essa macro do Aplicativo Microsoft Excel VBA, copia dados desejados de uma planilha principal para outras planilhas indicadas, observe que a macro faz a referencia para exportação de dados na coluna(A), com o prefixo do nome da Planilha, por exemplo PRODUTORES LISTA, ("P"), SB PECAS("S"), TB CODIGO("T")

Sub Copiando_dados_distribuindo_plans_desejadas()

Dim vPlanPrincipal, vPlanilhaP, vPlanilhaS, vPlanilhaT As String
Dim vContinuar As Boolean
Dim vPrimeiraLinha, vLinha As Integer
Dim vAtualPLinha, vAtualSLinha, vAtualTLinha As Integer

'nome referenciando as folhas de planilha
vPlanPrincipal = "BOM"
vPlanilhaP = PRODUTORES LISTA"
vPlanilhaS = "PARTES PECAS"
vPlanilhaT = "CODIGOS"

'Inicializando com as variáveis
vContinuar = True
vPrimeiraLinha = 13
vLinha = vPrimeiraLinha
vAtualPLinha = 12
vAtualSLinha = 12
vAtualTLinha = 12

Sheets(vPlanPrincipal).Select

'Um loop por todos os valores da coluna(A) até encontrar uma célula em branco
While vContinuar = True

'Quando encontrar uma célula em branco, não continua
If Len(Range("A" & CStr(vLinha)).Value) = 0 Then
vContinuar = False
'copiando e formatando dados
Else

'inserindo uma borda arredondada nas células
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeLeft).Weight = xlThin
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeTop).Weight = xlThin
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeBottom).Weight = xlThin
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeRight).Weight = xlThin
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlInsideVertical).Weight = xlThin

'referenciando às células da coluna(I)
Range("I" & CStr(vLinha)).Formula = "=H" & CStr(vLinha) & "*QTY"

'--- "A" ---
If Range("A" & CStr(vLinha)).Value = "A" Then

'Negrito e justificando à esquerda
Range(CStr(vLinha) & ":" & CStr(vLinha)).Font.Bold = True
Range(CStr(vLinha) & ":" & CStr(vLinha)).HorizontalAlignment = xlLeft

'se nao encontrar a primeira linha, insere uma linha em branco
If vLinha <> vPrimeiraLinha Then
Rows(CStr(vLinha) & ":" & CStr(vLinha)).Select
Selection.Insert Shift:=xlDown
vLinha = vLinha + 1
End If

'--- "P" ---
ElseIf Range("A" & CStr(vLinha)).Value = "P" Then

'Cópia dados avaliando das colunas B, C, F, G, para folha BMO
Range("B" & CStr(vLinha) & ",C" & CStr(vLinha) & ",F" & CStr(vLinha) & ",G" & CStr(vLinha) & ",I" & CStr(vLinha)).Select
Selection.Copy

'Para folha "LISTA COMPRADORES"
Sheets(vPlanilhaP).Select
Range("A" & CStr(vAtualPLinha)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

'adicionando bordas arredondadas nas células
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeLeft).Weight = xlThin
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeTop).Weight = xlThin
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeBottom).Weight = xlThin
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeRight).Weight = xlThin
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlInsideVertical).Weight = xlThin

'incrementando linha contador na planilha "LISTA COMPRADORES"
vAtualPLinha = vAtualPLinha + 1

'Retornando a planilha BOM no local de origem
Sheets(vPlanPrincipal).Select

'--- "S" ---
ElseIf Range("A" & CStr(vLinha)).Value = "S" Then

'copia avaliando as colunas B, C, e E da folha BMO
Range("B" & CStr(vLinha) & ",C" & CStr(vLinha) & ",E" & CStr(vLinha)).Select
Selection.Copy

'Cola os dados na planilha "PARTES PECAS"
Sheets(vPlanilhaS).Select
Range("A" & CStr(vAtualSLinha)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'copie valores das colunas D, F, G, e da folha BMO
Sheets(vPlanPrincipal).Select
Range("D" & CStr(vLinha) & ",F" & CStr(vLinha) & ",G" & CStr(vLinha) & ",I" & CStr(vLinha)).Select
Selection.Copy

'cola dados na planilha "PARTES PECAS"
Sheets(vPlanilhaS).Select
Range("D" & CStr(vAtualSLinha)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

'Insere bordas arredondadas nas células
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeLeft).Weight = xlThin
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeTop).Weight = xlThin
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeBottom).Weight = xlThin
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeRight).Weight = xlThin
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlInsideVertical).Weight = xlThin

'incrementa o contador de linhas na planilha "PARTES PECAS"
vAtualSLinha = vAtualSLinha + 1

'Retorna para planilha BMO e continua onde parou
Sheets(vPlanPrincipal).Select

'--- "T" ---
ElseIf Range("A" & CStr(vLinha)).Value = "T" Then

'copia valores da coluna B para planilha BMO
Range("B" & CStr(vLinha)).Select
Selection.Copy

'Cola os dados na planilha "CODIGOS"
Sheets(vPlanilhaT).Select
Range("A" & CStr(vAtualTLinha)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'insere vírgula nos lugares na coluna(B)
Range("B" & CStr(vAtualTLinha)).Value = ","

'Copia os valores de coluna(I) da planilha BMO)
Sheets(vPlanPrincipal).Select
Range("I" & CStr(vLinha)).Select
Selection.Copy

'Cola os valores na planilha "CODIGOS"
Sheets(vPlanilhaT).Select
Range("C" & CStr(vAtualTLinha)).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select

'insere bordas arredondadas nas células
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeLeft).Weight = xlThin
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeTop).Weight = xlThin
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeBottom).Weight = xlThin
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeRight).Weight = xlThin
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlInsideVertical).Weight = xlThin

'incrementa o contador da planilha "CODIGOS"
vAtualTLinha = vAtualTLinha + 1

'Retorna para a planilha BMO
Sheets(vPlanPrincipal).Select

End If

End If

vLinha = vLinha + 1

Wend

MsgBox "Os dados foram copiados com sucesso!!", vbInformation, "Saberexcel - site das macros"

End Sub

Aprenda Aplicativo Microsoft Excel VBA --(( Saberexcel ))--

Saberexcel - o site das macros
Essa macro do Aplicativo Microsoft Excel VBA, contém macro que copia determinados dados para outra folha de planilha.

Sub Copiar_Dados()

Dim vLinha As Integer
Dim vColACelulas As String
Dim vContinuar As Boolean

'Seleciona Plan1
Sheets("Plan1").Select
Range("A2").Select

'inicializando variáveis
vContinuar = True
vLinha = 2

'O loop por todos os valores de coluna A até uma célula em branco é encontrado ou o valor não faz
'combina com a célula valor de A2
While vContinuar = True

vLinha = vLinha + 1
vColACelulas = "A" & CStr(vLinha)

'encontrando uma célula em branco, não continua
If Len(Range(vColACelulas).Value) = 0 Then
vContinuar = False
End If

'A primeira ocorrência encontrada que não combinou com a célula valor de A2, não continua
If Range("A2").Value <> Range(vColACelulas).Value Then
vContinuar = False
End If

Wend

'Dados da cópia de colunas A - C
Range("A2:C" & CStr(vLinha - 1)).Select
Selection.Copy

'cola na planilha(Plan2) na célula (A1)
Sheets("Plan2").Select
Range("A1").Select
ActiveSheet.Paste

MsgBox "Dados copiados com sucesso", vbInformation, "Saberexcel - o site das macros"

End Sub

Aprenda Aplicativo Microsoft Excel VBA SaberExcel