Home Excel - Dicas Microsoft Excel VBA Excel VBA - Copiar Excel planilha vba copia distribuindo dados produtos nas planilhas

Excel planilha vba copia distribuindo dados produtos nas planilhas

Sáb, 20 de Novembro de 2010 17:10 Expedito Marcondes
E-mail Imprimir PDF

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 tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel



 Baixe o exemplo de planilha contendo a macro acima
 vba copia distribuindo dados produtos nas planilhas (22.56 kB)

Tags:
Última atualização em Qua, 10 de Agosto de 2011 08:25  

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein

Código de segurança
Atualizar

PROMOÇÃO DIDÁTICOS SABEREXCEL



Adquira já o Acesso Imediato
à Area de Membros

Compra Grantida --- Entrega Imediata

Aprenda Excel VBA com Simplicidade de 
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.

'-------------------------------------'
Entrega Imediata:
+  500 Video Aulas MS Excel VBA
+  35.000 Planilhas Excel e VBA
+  Coleção 25.000 Macros MS Excel VBA
+  141 Planilhas Instruções Loops
+  341 Planilhas WorksheetFunctions(VBA)
+    04 Módulos Como Fazer Excel VBA
+  Curso Completo MS Excel VBA
+  Planilhas Inteligentes

Pesquisa Google SaberExcel

Google

Contatos Equipe Saberexcel

Navegar pelo Site

Outros Assuntos

Publicidade Google

<script type="text/javascript"><!--

google_ad_client = "ca-pub-2317234650173689";

/* retangulo 336 x 280 */

google_ad_slot = "0315083363";

google_ad_width = 336;

google_ad_height = 280;

//-->

</script>

<script type="text/javascript"

src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

</script>

Publicidade

Tags Populares

RSFirewallProtected

22.12.2024

Google Associados

Depoimentos

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA