Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Resumir a Macro
 
Notifications
Clear all

Resumir a Macro

 
Página 1 / 2
2024 - VBA & Macros
Post Recente por fazerbem 8 anos atrás
19 Posts
2 Usuários
0 Reactions
2,088 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Bom dia

Tento sempre fazer do meu jeito, antes de jogar a toalha,

A amcro abaixo, esta Ok e funcionando perfeitamente, porem como podem reparar ficou muito grande e talvez haja uma maneira mais Light de fazer o mesmo, pois quanto maior a macro mais tempo levará para executar a funcao correto ?

Entao teria como um amigo aqui abreviar os Comandos a partir de :

'---------------------------------------
'Aqui faz uma verificacao se existem outros produtos

Grato

Andre

 Sub MAIS_VENDIDOS_MENOS_VENDIDOS()
 
 '  Pocisionar Produto no Ranking
 
Dim Venda As String
Venda = Range("B1").Value

Dim WC, WR As Worksheet

Dim Cont As Long
Dim Produto As String
Application.ScreenUpdating = False

Dim WT     As Worksheet

Set WC = Worksheets("Ranking")
Set WR = Worksheets(Venda)

Produto = WR.Range("F72").Value
       
GoTo Voltar
Voltar:

Sheets("Ranking").Visible = True
    WC.Activate
    WC.Range("B2").Activate
    
    Do While ActiveCell <> ""
    
If ActiveCell = Produto Then
    
    ActiveCell.Offset(0, 1).Activate
    Cont = ActiveCell
    Cont = Cont + 1
    ActiveCell = Cont
Else
    ActiveCell.Offset(1, 0).Activate
    
End If
      
Loop
    WR.Activate
 
  
'---------------------------------------
'Aqui faz uma verificacao se existem outros produtos

If Range("F73").Value <> "" And Range("I73").Value = 0 Then
Produto = WR.Range("F73").Value
Range("I73").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F74").Value <> "" And Range("I74").Value = 0 Then
Produto = WR.Range("F74").Value
Range("I74").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F75").Value <> "" And Range("I75").Value = 0 Then
Produto = WR.Range("F75").Value
Range("I75").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F76").Value <> "" And Range("I76").Value = 0 Then
Produto = WR.Range("F76").Value
Range("I76").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F77").Value <> "" And Range("I77").Value = 0 Then
Produto = WR.Range("F77").Value
Range("I77").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F78").Value <> "" And Range("I78").Value = 0 Then
Produto = WR.Range("F78").Value
Range("I78").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F79").Value <> "" And Range("I79").Value = 0 Then
Produto = WR.Range("F79").Value
Range("I79").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F80").Value <> "" And Range("I80").Value = 0 Then
Produto = WR.Range("F80").Value
Range("I80").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F81").Value <> "" And Range("I81").Value = 0 Then
Produto = WR.Range("F81").Value
Range("I81").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F82").Value <> "" And Range("I82").Value = 0 Then
Produto = WR.Range("F82").Value
Range("I82").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F83").Value <> "" And Range("I83").Value = 0 Then
Produto = WR.Range("F83").Value
Range("I83").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F84").Value <> "" And Range("I84").Value = 0 Then
Produto = WR.Range("F84").Value
Range("I84").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F85").Value <> "" And Range("I85").Value = 0 Then
Produto = WR.Range("F85").Value
Range("I85").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F86").Value <> "" And Range("I86").Value = 0 Then
Produto = WR.Range("F86").Value
Range("I86").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If


 End Sub
 
Postado : 09/09/2016 8:05 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Antes de mais nada (seria bom ver o arquivo..mas..), tentou usar os recursos para optimizar sua macro?
Fonte: http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
Fonte: http://www.cpearson.com/excel/optimize.htm

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/09/2016 8:28 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim:

Sub MAIS_VENDIDOS_MENOS_VENDIDOS()
'  Pocisionar Produto no Ranking

Dim Produto As String, Venda As String
Dim Cont As Long, x as integer
Dim WC As Worksheet, WR As Worksheet, Dim WT  As Worksheet

Application.ScreenUpdating = False

Set WC = Worksheets("Ranking")
Set WR = Worksheets(Venda)

Venda = Range("B1").Value
Produto = WR.Range("F72").Value

Voltar:
WC.Activate
WC.Range("B2").Activate
    
Do While ActiveCell <> ""
      If ActiveCell = Produto Then
    ActiveCell.Offset(0, 1).Activate
    Cont = ActiveCell
    Cont = Cont + 1
    ActiveCell = Cont
Else
    ActiveCell.Offset(1, 0).Activate
End If
Loop
'---------------------------------------
    WR.Activate
'Aqui faz uma verificacao se existem outros produtos

For x=73 to 86
If Range("F"&x).Value <> "" And Range("I"&x).Value = 0 Then
Produto = WR.Range("F"&x).Value
Range("I"&x).Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
End If
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/09/2016 2:58 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Reinaldo, vou testar , nao sei se hj dara tempo, mas amanha sim, entao te digo ok. Porem tenho certeza desde ja que vai funcionar.

Peco ao amigo que de uma olhada em meu outro post no item 4 em que o botao de rolagem nao funciona apos sair da tela de vendas, entra menu Macro e selecionar aba Minha Empresa por exemplo. Note que a barra de rolagem do mouse nao ira funcionar.

Se resolver da um alo e me mostra onde errei no codigo.

Abracos

Andre

 
Postado : 09/09/2016 3:18 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Reinaldo, deu certo nao, mando a planilha anexa

Grato

Andre

 
Postado : 09/09/2016 3:50 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

No inicio do topico vc disse que a rotina estava funcionando, então não me atentei a detalhes, agora com seu modelo algumas duvidas/erros
Erros: Rotina dentro de outra rotina, isso gera erro.
Na linha onde atribui a variável o valor da planilha Venda, está com erro na declaração, venda deve estar entre aspas. No seu modelo a planilha é Venda1
Duvidas em sua rotina no primeiro tópico começa a ler dados na linha 73, neste modelo linha 72.
E preciso decidir onde cada dado inicia/está
Tentando adaptar a seu modelo/exemplo

Sub MAIS_VENDIDOS_MENOS_VENDIDOS()
'  Pocisionar Produto no Ranking

Dim Produto As String, Venda As String
Dim Cont As Long, x As Integer
Dim WC As Worksheet, WR As Worksheet, WT As Worksheet

Application.ScreenUpdating = False

Set WC = Worksheets("Ranking")
Set WR = Worksheets("Venda")

Venda = Range("B1").Value
Produto = WR.Range("F71").Value

Voltar:
WC.Activate
WC.Range("B2").Select
    
Do While ActiveCell <> ""
      If ActiveCell = Produto Then
    ActiveCell.Offset(0, 1).Activate
    Cont = ActiveCell
    Cont = Cont + 1
    ActiveCell = Cont
Else
    ActiveCell.Offset(1, 0).Activate
End If
Loop
'---------------------------------------
    WR.Activate
'Aqui faz uma verificacao se existem outros produtos

For x = 72 To 86
If Range("F" & x).Value <> "" And Range("I" & x).Value = 0 Then
Produto = WR.Range("F" & x).Value
Range("I" & x).Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
End If
Next
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/09/2016 5:35 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

No meu modelo de codigo esta funcionando , note que a dim nome esta logo no inicio e vc pos depois dai não funcionou, .
Alem disso faltou o next.

Meu codigo funciona, so ta grande demais. O seu ficou curto e e isso que eu quero, mas esta com erro. Por isso lhe mandeiuma ideia da tabela seguindo as mesmas posices das celulas do que tenho aqui.

Comeca a ler sim na linha 72. E isso mesmo. Veja o exemplo da plan que mandei que vai entender, utilize meu codigo e não o seu dai vai entender com certeza.

 
Postado : 09/09/2016 6:03 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

E o seu que deu os erros reportados.
qual o retorno esperado?

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/09/2016 6:31 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Eu coloquei (venda) sem as aspas, justamente porque tenho tres telas de vendas por isso logo no inicio eu coloquei uma Dim , venda= range("b1") entendeu agora, vai depender de qual aba de vendas estou se venda1, se venda2 , se venda3

 
Postado : 09/09/2016 6:50 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

As duas fazem a mesma "coisa", se estão certas ou não ....

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/09/2016 6:16 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

As duas fazem a mesma "coisa", se estão certas ou não ....

Agora sim ficou certinho conforme eu queria, vi que começou pela linha 71, mas nao fez diferenca alguma. O importante, e apos a passagem a linha 73 em diante se for verdadeira,estarem a marcadas com 1.

Muito Obrigado por sua ajuda e se nao for te explorar muito, eu adaptei a Macro abaixo conforme meu entendimento, porem nao funcionou, poderia me passar por gentileza ?

[code]' ATUALIZAR ESTOQUE DE PRODUTOS

 'Declaração de Variaveis para transferir os dados de Vendas1 para Vendas Feitas

    Dim Ws3      As Worksheet
    Dim Dest    As Range
 '---------------------------------------------
 
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D72:H72").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    
If Range("D73").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D73:H73").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D74").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D74:H74").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D75").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D75:H75").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D76").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D76:H76").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D77").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D77:H77").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D78").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D78:H78").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D79").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D79:H79").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D80").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D80:H80").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D81").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D81:H81").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D82").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D82:H82").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D83").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D83:H83").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D84").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D84:H84").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D85").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D85:H85").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else
GoTo Fim_Lancamentos
    End If
    
If Range("D86").Value <> "" Then
    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D86:H86").Copy  'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False
    Else

    End If
    
GoTo Fim_Lancamentos
Fim_Lancamentos:


Sheets("LANCAMENTOS ENTRADA & SAIDA").Activate

    Range("A1:E30808").Activate
    ActiveWorkbook.Worksheets("LANCAMENTOS ENTRADA & SAIDA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("LANCAMENTOS ENTRADA & SAIDA").Sort.SortFields.Add Key:=Range _
        ("A2:A15583"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("LANCAMENTOS ENTRADA & SAIDA").Sort
        .SetRange Range("A1:E15583")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F4").Activate

Sheets("LANCAMENTOS ENTRADA & SAIDA").Visible = False

        
  Application.ScreenUpdating = 1
Application.Calculation = xlCalculationAutomatic

 End Sub[/code]
 
Postado : 10/09/2016 2:01 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Cheguei a isso aqui mas da erron em : Range("D:H" & x).Copy 'Copia o intervalo

Sub Atualizar_Estoque()
'
'Aqui Atualiza os produtos no Estoque que foram vendidos

Application.ScreenUpdating = 0
 Application.DisplayAlerts = False 'desabilite o alerta
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
'

Sheets("LANCAMENTOS ENTRADA & SAIDA").Visible = True

' ATUALIZAR ESTOQUE DE PRODUTOS

 'Declaração de Variaveis para transferir os dados de Vendas1 para Vendas Feitas

    Dim Ws3      As Worksheet
    Dim Dest    As Range
 '---------------------------------------------
 Dim x As Integer
 
Voltar:
 For x = 72 To 86
If Range("D" & x).Value <> "" Then

    Set Ws3 = Sheets("LANCAMENTOS ENTRADA & SAIDA") 'Referencia a guia Mais Vendidos como Ws3
    Set Dest3 = Ws3.Range("A2").Range("B20000").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("D:H" & x).Copy 'Copia o intervalo
    Dest3.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
    Application.CutCopyMode = False

GoTo Voltar
End If
Next
 
Postado : 10/09/2016 2:15 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Sem olhar toda a rotina, mas na linha do erro " Range("D:H" & x).Copy 'Copia o intervalo", falta a referencia a linha da coluna d.
creio que deveria ser: Range("D" & x & ":H" & x).copy

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/09/2016 4:28 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Reinaldo, fora a duvida acima, tenho mais esta abaixo:

Aqui neste comando: ( Cont = Cont + 1 ) teria que ao inves de somar +1 , somar a QNT que esta na celula Range("G" & x).Value da Plan(Venda). tem como ?

Eu tentei isso mas como sempre deu erro.

Cont = Cont + Sheets(Venda).Range("G" & x).Value '+ 1

 
Postado : 10/09/2016 4:30 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Sem olhar toda a rotina, mas na linha do erro " Range("D:H" & x).Copy 'Copia o intervalo", falta a referencia a linha da coluna d.
creio que deveria ser: Range("D" & x & ":H" & x).copy

Deu certo sim, apenas tive que tirar o

Voltar:

Goto Voltar

Grato mas esta vez, aguardo agora a duvida mais acima deste agradecimento

 
Postado : 10/09/2016 4:44 pm
Página 1 / 2
Forum Jump:
  Tópico Anterior
Próximo Tópico