Este fórum está sendo desativado

[fazerbem]

Ola !

Tenho uma planilha de vendas ao qual com a ajuda do AlexandreVBA, consegui adquirir uma excelente forma de organizacao. Mas agora peciso incluir mais um recurso ao qual irei relatar abaixo.

Tenho uma planilha chamada Lancar comissoes, ao qual organiza todos os pedidos feitos, as quais as informacoes sao captadas por outra planilha de nome PEDIDO. Ao captar essas informacoes, tenho as celulas da tabela PEDIDO ( B= Data, C= Nome Fantasia, D= Razao social, E= Total do pedido F= comissao e G= vendedor ), na Tabela LANCAR COMISSOES. Essas celulas sao coladas na planilha Lancar comissao, cada vez que uma venda for feita, linha abaixo de linha.

Tabela PEDIDO



Tabela Lancar Comissoes



Assim ja esta funcionado, pois nas colunas ( J= Moyses, L= Marcia, N= Claudio e P= Sandro ) os valores de comissoes sao serao baseados atraves das colunas ( F= Comissao e G= Vendedor ) atraves da formula - =SE(G5="Moyses",F5/2,"") e assim se extende.

Até aqui esta tudo funcionando corretamente atraves de Macro.

Entao quero agora criar uma planilha para cada um desses vendedores separadamente, e assim poder enviar a eles o resumo individual. Para isso é preciso que apos criar uma nova Macro, ou adicionar o comando a Macro ja existente, cada comissao seja transportada para a planilha especifica. Assim sendo a Linha onde fica o vendedor Moyses vai ser copiada na planilha Moyses, a linha do vendedor Claudio vai pra planilha Claudio e assim sucessivamente, sendo que cada vez que isso acontecer, cada planilha ( Marcia, moyses etc, os dados sejam copiados de cima pra baixo ).

Abaixo segue a imagem da planilha de nome Moyses e mais abaixo a Planilha Claudio e assim sucessivamente ate quantos vendedores forem necessarios.

Planilha Moyses



Planilha Claudio



Mas percebam que a Planilha que mando em anexo conforme na Tabela Pedido vamos inserindo os dados e trocando-se os Vendedores, o transporte das informacoes nao iniciam-se corretamente na Celula B8 das respectivas planilhas dos vendedores. Notem porem que a Palnilha Lancar comissao funciona corretamente, iniciando-se pela Celula B4.

Ao abrir a Macro, parece estar tudo certo, nao acho o erro.

A senha desbloqueio é - 1234

Será que poderiam me ajudar ?


Andre Luiz

[fazerbem]

Sera que uma funcao SE dentro da Macro resolveria meu problema ? Se sim , entao pode me ajudar a introduzir o comando na macro ?

Grato

[alexandrevba]

Boa tarde!!

No poste #3630 do link abaixo, há uma rotina que cria os arquivos baseado nas guias.
http://gurudoexcel.com/forum/viewtopic.php?f=12&t=638

Att

[fazerbem]

Oi Alexandre, eu ja tinha lido, mas nao entendi, sera que seria possivel vc descrever o comando ?

Andre

[fazerbem]

AlexandrevBA , se vc baixar a planilha que mandei acima em anexo, entenderá o problema, pois bastara mudar o nome do vendedor na Palnilha Pedido e executar a macro, vera que nas planilhas Andre, Moyses, Marcia , Claudio e Sandro, nao vai na sequencia de linhas . ele pula as linhas.

Sendo assim te peço que me ajude a concertar o comando da Macro.

Andre

[alexandrevba]

Boa noite!!

Veja se eu entendi, você pretende fazer um arquivo de cada vendedor?

O código que usei não de minha autoria.

Obs: Uma vez que os arquivos são gerados, caso rodar a macro novamente os arquivos serão sobre postos.



Att

[fazerbem]

oi alexandre nao seria assim, vou te explicar

[fazerbem]

na minha macro esta ok ate ser transportado para Lancar comissao, mas veja o que fiz na planilha lancar comissao a partir da coluna "S".

Faca uma simulacao fazendo vendas a cada vendedor, e depois vai na pasta de cada vendedor e veja como transportou, era pra ser transportado para a partir da celula B3 de cada vendedor

[fazerbem]

eu nao quero criar uma nova planilha, mas sim transportar para as pastas ja criadas, Andre, Marcia, Moyses etc, nessa mesma planilha , deu pra entender ?
Veja a minha macro que vai entender a ideia, pois esta copiando, porem esta indo desarrumado nas linhas.

[alexandrevba]

Boa noite!!


Desproteja TODAS as guias!!, vá em cada uma selecione de B8 até F52, aperte a tecla Delete, após fazer isso em cada guia, salve o arquivo, rode a macro!


Att

[fazerbem]

Continua dando erro, vou explicar pera ai sai nao

[fazerbem]

fiz o que disse, mas ao salvar como vendedor Andre, cai beleza na linha 8
Em seguida ao salvar como Moyses cai na linha 9, quando o certo seria cair na linha 8'
Em seguida salvei como Vendedor Claudio, e caiu na linha 10, quando deveria cair na linha 8 e assim sucessivamente.

[fazerbem]

gostaria que testasse seguindo os 4 vendedores, depois volte e faca de novo para os 4 vendedores.

O certo em cada planilha vendedor seria ocupar entao as linhas 8 e 9 de cada planilha entendeu ?

[fazerbem]

Alexandre, perceba que na Planilha Lancar Comissao, sai um de baixo do outro corretinho. Isso so acontece nas outras planilhas com os vendedores. Se gravo como vendedor Andre grava a Linha 8 , se gravo depois como vendedor Moyses cai na linha 9 a linha 8 fica branca, se volto a gravar como vendedor Andre cai na linha 10, 9 fica em branco e assim vai.

Bem acho que agora expliquei certo.

Por favor se puder ajudar eu agradeço, e sei que vai, pois vc é o fera da Macro.

Andre

[alexandrevba]

Bom dia!!

Veja essasegunda versão

Código: Selecionar todos

Sub AleVBA_778V2()
Dim LR As Long, LR2 As Long, LR3 As Long, LR4 As Long, LR5 As Long
Dim sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet

Set sh = Worksheets("Andre")
Set sh2 = Worksheets("Moyses")
Set sh3 = Worksheets("Claudio")
Set sh4 = Worksheets("Marcia")
Set sh5 = Worksheets("Sandro")

LR = sh.Cells(Rows.Count, "B").End(xlUp).Row
LR2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row
LR3 = sh3.Cells(Rows.Count, "B").End(xlUp).Row
LR4 = sh4.Cells(Rows.Count, "B").End(xlUp).Row
LR5 = sh5.Cells(Rows.Count, "B").End(xlUp).Row

Application.ScreenUpdating = 0
    With Worksheets("LANCAR COMISSAO")
        .Range("T5:X5").Copy
        Worksheets("Andre").Range("B8:B" & LR).Offset(1).PasteSpecial Paste:=xlPasteValues
        .Range("T8:X8").Copy
        Worksheets("Moyses").Range("B8:B" & LR2).Offset(1).PasteSpecial Paste:=xlPasteValues
        .Range("T11:X11").Copy
        Worksheets("Claudio").Range("B8:B" & LR3).Offset(1).PasteSpecial Paste:=xlPasteValues
        .Range("T14:X14").Copy
        Worksheets("Marcia").Range("B8:B" & LR4).Offset(1).PasteSpecial Paste:=xlPasteValues
        .Range("T17:X17").Copy
        Worksheets("Sandro").Range("B8:B" & LR5).Offset(1).PasteSpecial Paste:=xlPasteValues
    End With
     Application.CutCopyMode = False
    Application.ScreenUpdating = 1
End Sub

Att

[fazerbem]

Bom DIa Alexandre, so vc mesmo pra me aturar irmao. Ja te falo .

Andre

[fazerbem]

ainda nao deu, usei a VBA e selecionei o vendedor na Planilha Pedido sendo Andre
caiu certinho na Linha 8 da palnilha Andre.

Usei Vendedor Marcia, e ao ir para a planilha Marcia a linha 8 estava em branco e os dados foi pra coluna 9 e assim sucessivamente com os outros vendedores, nas linhas 10, 11 e 12

[fazerbem]

pelo que entendi, ele esta copiando dados em branco e por isso que esta pulando linhas em cada planilha, o certo talvez seri incluir um funcoa IF, ou seja, se as linhas T 5 a T17 tivessem em branco entao nao seriam copiadas, acho que seria assim o certo.

Andre

[alexandrevba]

Bom dia!!

Teste o código abaixo com o anexo.

Código: Selecionar todos

Sub AleVBA_778V3()
Dim sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet, wsCom As Worksheet

Set wsCom = Worksheets("LANCAR COMISSAO")
Set sh = Worksheets("Andre")
Set sh2 = Worksheets("Moyses")
Set sh3 = Worksheets("Claudio")
Set sh4 = Worksheets("Marcia")
Set sh5 = Worksheets("Sandro")

    If wsCom.Range("$T$5").Value <> "" Then
        wsCom.Range("$T5:$X5").Copy
        sh.Activate
        sh.Range("B7:B" & Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row).Offset(1).PasteSpecial Paste:=xlPasteValues
    ElseIf wsCom.Range("T8").Value <> "" Then
        wsCom.Range("$T$8:$X$8").Copy
        sh2.Activate
        sh2.Range("B7:B" & Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row).Offset(1).PasteSpecial Paste:=xlPasteValues
    ElseIf wsCom.Range("$T$11").Value <> "" Then
        wsCom.Range("$T$11:$X$11").Copy
        sh3.Activate
        sh3.Range("B7:B" & Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row).Offset(1).PasteSpecial Paste:=xlPasteValues
    ElseIf wsCom.Range("$T$14").Value <> "" Then
        wsCom.Range("$T$14:$X$14").Copy
        sh4.Activate
        sh4.Range("B7:B" & Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row).Offset(1).PasteSpecial Paste:=xlPasteValues
    ElseIf wsCom.Range("$T$17").Value <> "" Then
        wsCom.Range("$T$17:$X$17").Copy
        sh5.Activate
        sh5.Range("B7:B" & Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row).Offset(1).PasteSpecial Paste:=xlPasteValues
    Else
        Exit Sub
    End If
     Application.CutCopyMode = False
     wsCom.Activate
     Application.ScreenUpdating = 1
End Sub

Att

[Reinaldo]

Veja se atende