Detalhes de vba copia distribuindo dados produtos nas planilhas

PropriedadeValor
Nome:vba copia distribuindo dados produtos nas planilhas
Descricao:

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 ))--



Nome do arquivo:vba copia distribuindo dados produtos nas planilhas.zip
Tamanho: Vazio
Tipo:zip (Tipo de Mime: application/zip)
Autor:SaberExcel
Criado em: 20/11/2010 18:14
Visitas:Todos
Responsavel:Editor
Acessos:606 Acessos
Atualizado em: 20/11/2010 18:16
Site: