Selecionar intervalo com VBA

[Fabiano Martinss]

Boa noite 

 

Preciso selecionar um intervalo considerando o numero de linhas que estara expresso em uma celula no caso "L2".

neste caso preciso selecionar de a1 até e9 (7 linhas conforme L2).

 

alguem pode me ajudar?

 

desde já obrigado 

teste.xlsx

[Xflapc2]

amigo, de a1 até e9 tem 9 linhas e cinco colunas, no caso voce quer o numero de linhas só que contadas a partir da 2º. E a coluna final sempre será a "E"?

Range(Cells(1, 1), Cells(Range("L2").Value + 7, 5)).Select

[Fabiano Martinss]

Boa tarde amigo

 

Mais ou menos isso!

Com os filtros aplicados de A1:E9 tem 7 linhas de dados e o cabeçalho. Número de linhas contadas a partir do cabeçalho.

O número de colunas será fixo,porém, o número de linhas a serem selecionadas será o resultado de uma formula que esta em L2.

 

Na macro e tabela original irei aplicar alguns filtros tal qual esta no exemplo e depois irei copiar 15 colunas (A:O) e o número de linhas do resultado da fórmula em L2.

 

Me fiz entender?

[Visitante]

inclui o cabeçalho no valor de L2:

Sub SelecionaVisíveis1()  Dim rVis As Range, k As Long    For Each rVis In Range("A:A").SpecialCells(xlCellTypeVisible)      k = k + 1: If k = [L2] Then Exit For    Next rVisRange("A1:E" & rVis.Row).SelectEnd Sub

 

não inclui o cabeçalho:

Sub SelecionaVisíveis2()  Dim rVis As Range, k As Long    For Each rVis In Range("A:A").SpecialCells(xlCellTypeVisible)      k = k + 1: If k = [L2] + 1 Then Exit For    Next rVisRange("A1:E" & rVis.Row).SelectEnd Sub

[Fabiano Martinss]

Bom dia osvaldomp

 

Tentei inserir o código e ele acaba travando.

Pode me ajudar inserir ele no restante da macro.

 

Fabiano.xlsx

[Visitante]

 

Pode me ajudar inserir ele no restante da macro.

Fala, Fabiano.

Se entendi corretamente você quer associar o código que postei a um código já existente no seu arquivo.

Porém, no arquivo que você colocou no link no post #5 não encontrei nenhum código instalado.   

 

Você testou isoladamente os códigos que postei (sem associar com outros códigos) ?

Antes de associar com outros códigos é preciso saber se os códigos atendem a sua necessidade.  

[Fabiano Martinss]

Olá osvaldomp

 

Isso! Na verdade, acredito que no meu código só falte esta linha.

 

Testei! me parece que não funciona pegando o resultado da fórmula  ,porém, com o número digitado ele seleciona.

 

A forma que achei para usar foi a que esta abaixo aparece uma mensagem "erro 400".

Ela faz os filtros, seleciona, copia, troca de aba, ai aparece a mensagem. 

 

Sub SEPARAR_ITENS_A_CONTAR()

'

' SEPARAR_ITENS_A_CONTAR Macro

'

 

    Sheets("1504").Select

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=15, Criteria1:="1504"

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=16, Criteria1:="="

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=14, Criteria1:="A"

    

    Call SelecionaVisíveis1

    

    Selection.Copy

    Sheets("ITENS A CONTAR").Select

    Range("A1").Select

    Selection.End(xlDown).Select

    ActiveCell.Offset(1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

        

    Sheets("1504").Select

    ActiveSheet.ShowAllData

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=15, Criteria1:="1504"

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=16, Criteria1:="="

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=14, Criteria1:="B"

    

    Call SelecionaVisíveis1

    

    Selection.Copy

    Sheets("ITENS A CONTAR").Select

    Range("A1").Select

    Selection.End(xlDown).Select

    ActiveCell.Offset(1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

 

 

 Sheets("1504").Select

    ActiveSheet.ShowAllData

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=15, Criteria1:="1504"

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=16, Criteria1:="="

    ActiveSheet.Range("$A$1:$Q$4000").AutoFilter Field:=14, Criteria1:="C"

    

    Call SelecionaVisíveis1

    

    Selection.Copy

    Sheets("ITENS A CONTAR").Select

    Range("A1").Select

    Selection.End(xlDown).Select

    ActiveCell.Offset(1, 0).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

 

End Sub

[Visitante]

Testaí, Fabiano.

Sub SEPARAR_ITENS_A_CONTAR_novo()  Dim rVis As Range, k As Long, x As Long, LRo As Long, LRd As Long  Application.ScreenUpdating = False    With Sheets("1504").[A1].CurrentRegion      .Cells.AutoFilter      LRo = .Cells(Rows.Count, 1).End(xlUp).Row      For x = 2 To 4        .AutoFilter Field:=15, Criteria1:="1504"        .AutoFilter Field:=16, Criteria1:="="        .AutoFilter Field:=14, Criteria1:=.Cells(x, 19)        k = 0          For Each rVis In .Range("A2:A" & LRo).SpecialCells(xlCellTypeVisible)            k = k + 1: If k = Application.MRound(.Cells(x, 21), 1) Then Exit For          Next rVis          LRd = Sheets("ITENS A CONTAR").Cells(Rows.Count, 1).End(xlUp).Row        .Range("A2:O" & rVis.Row).Copy Sheets("ITENS A CONTAR").Cells(LRd + 1, 1)        .Cells.AutoFilter      Next x    End With  Application.ScreenUpdating = TrueEnd Sub

[Fabiano Martinss]

Olá caro osvaldomp

 

Funcionou perfeitamente   muito obrigado

Porém, tenho que aplicar este código em 8 abas diferentes pensei que fosse só trocar o nome da aba base. Nestas outras abas o código esta colando fórmulas ai acontece isso "#DIV/0!" nas celulas que contém as fórmulas.

Tem ideia do que é? Abaixo esta o código que coloquei para outra aba.

 

Sub SEPARAR_ITENS_A_CONTAR_novo()
  Dim rVis As Range, k As Long, x As Long, LRo As Long, LRd As Long
  Application.ScreenUpdating = False
    With Sheets("1505").[A1].CurrentRegion
      .Cells.AutoFilter
      LRo = .Cells(Rows.Count, 1).End(xlUp).Row
      For x = 2 To 4
        .AutoFilter Field:=15, Criteria1:="1505"
        .AutoFilter Field:=16, Criteria1:="="
        .AutoFilter Field:=14, Criteria1:=.Cells(x, 19)
        k = 0
          For Each rVis In .Range("A2:A" & LRo).SpecialCells(xlCellTypeVisible)
            k = k + 1: If k = Application.MRound(.Cells(x, 21), 1) Then Exit For
          Next rVis
          LRd = Sheets("ITENS A CONTAR").Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A2:O" & rVis.Row).Copy Sheets("ITENS A CONTAR").Cells(LRd + 1, 1)
        .Cells.AutoFilter
      Next x
    End With
  Application.ScreenUpdating = True
End Sub

[Visitante]

Porém, tenho que aplicar este código em 8 abas diferentes

 ...               

 

With Sheets("1505").[A1].CurrentRegion  

No código do post #8 a planilha "1504" é a planilha de origem dos dados e a  "ITENS A CONTAR" é a planilha de destino dos dados.

Me parece que as 8 planilhas a que você se refere são as planilhas de origem dos dados. É isso?

Por enquanto sabemos o nome de duas delas: "1504" e "1505". Falta você nos informar o nome das outras 6...     

Como você não informou também, estou supondo que a estrutura das demais 7 planilhas é idêntica à estrutura da "1504"...   e que a planilha destino dos dados será sempre a "ITENS A CONTAR"...

 

[Fabiano Martinss]

Perfeito!

Em estrutura as planilhas são idênticas(1504,1505,4055,1509,1511,1504NP,1504PP,1504PO) e o destino é itens a contar.

Pensei que depois de pronto o código, fosse só trocar o nome da base dentro do código.   

O nome da aba dentro do código influencia no resultado?

[Visitante]

O nome da aba dentro do código influencia no resultado?

Sim. O comando abaixo determina ao código que a planilha "1504" será considerada em comandos seguintes:

With Sheets("1504")

 

 

Este código irá atuar nas 8 planilhas. Se ao rodar o código ocorrer algum problema ou o resultado não for o esperado, disponibilize o seu arquivo com o código instalado e com as explicações do que ocorreu e ou do que deveria ocorrer.

Sub SEPARAR_ITENS_A_CONTAR_novo()  Dim rVis As Range, k As Long, x As Long, LRo As Long, LRd As Long, wsPlan As Worksheet  Application.ScreenUpdating = False   For Each wsPlan In Worksheets(Array("1504", "1505", "4055", "1509", "1511", "1504NP", "1504PP", "1504PO"))    With wsPlan.[A1].CurrentRegion      .Cells.AutoFilter      LRo = .Cells(Rows.Count, 1).End(xlUp).Row      For x = 2 To 4        .AutoFilter Field:=15, Criteria1:=wsPlan.Name        .AutoFilter Field:=16, Criteria1:="="        .AutoFilter Field:=14, Criteria1:=.Cells(x, 19)        k = 0          For Each rVis In .Range("A2:A" & LRo).SpecialCells(xlCellTypeVisible)            k = k + 1: If k = Application.MRound(.Cells(x, 21), 1) Then Exit For          Next rVis          LRd = Sheets("ITENS A CONTAR").Cells(Rows.Count, 1).End(xlUp).Row        .Range("A2:O" & rVis.Row).Copy Sheets("ITENS A CONTAR").Cells(LRd + 1, 1)        .Cells.AutoFilter      Next x    End With  Next wsPlan  Application.ScreenUpdating = TrueEnd Sub

[Fabiano Martinss]

Bom dia  osvaldomp

 

O código funcionou perfeitamente sem problemas só não esta colando corretamente.

 

Na verdade nas colunas "L", "M","N" não esta sendo colado somente valores esta colando fórmulas ai esta dando erro de referencia nas fórmulas.

Eu preciso que os códigos atuem de forma independente nas abas (um de cada vez).

No post#11 perguntei se o nome da aba influência em colar somente valores ou fórmulas.

 

Tentei anexar a planilha mas foi cancelado anexo muito  grande

[Patropi]

Fabiano

 

Poste seu arquivo num site gratuito como:

 

www.sendspace.com   (não é necessário cadastro)

 

Depois cole o link aqui no fórum.

 

[]s

[Fabiano Martinss]

olá Patropi

 

Estou no trabalho e naõ tenho acesso.

Irei postar mais tarde de casa.

 

valeu

[Visitante]

Na verdade nas colunas "L", "M","N" não esta sendo colado somente valores esta colando fórmulas ...

Testei aqui (XL 2010) e cola valores e não fórmulas. Mas alterei o código para colar valores.

 

Eu preciso que os códigos atuem de forma independente nas abas (um de cada vez).

Alterei o código de forma que será exibida uma Caixa pedindo o nome da planilha a ser processada.

Na Caixa coloque o nome de uma das planilhas, sem espaço, sem aspas, sem nenhum outro caracter: exs. 1504 ou 1511 ou 1504NP

 

No post#11 perguntei se o nome da aba influência em colar somente valores ou fórmulas.

Não. Não tem relação. O comando PasteSpecial XLValues que arescentei é que cola valores e não fórmulas.

 

Substitua o código anterior por este:

Sub SEPARAR_ITENS_A_CONTAR_V3()  Dim rVis As Range, k As Long, x As Long, LRo As Long, LRd As Long, wsPlan As String  Application.ScreenUpdating = False    wsPlan = Application.InputBox("COLOQUE O NOME DA PLANILHA")    On Error GoTo ERRmsg    With Sheets(wsPlan).[A1].CurrentRegion      .Cells.AutoFilter      LRo = .Cells(Rows.Count, 1).End(xlUp).Row      For x = 2 To 4        .AutoFilter Field:=15, Criteria1:=Sheets(wsPlan).Name        .AutoFilter Field:=16, Criteria1:="="        .AutoFilter Field:=14, Criteria1:=.Cells(x, 19)        k = 0          For Each rVis In .Range("A2:A" & LRo).SpecialCells(xlCellTypeVisible)            k = k + 1: If k = Application.MRound(.Cells(x, 21), 1) Then Exit For          Next rVis          LRd = Sheets("ITENS A CONTAR").Cells(Rows.Count, 1).End(xlUp).Row        .Range("A2:O" & rVis.Row).Copy        Sheets("ITENS A CONTAR").Cells(LRd + 1, 1).PasteSpecial xlValues        .Cells.AutoFilter      Next x    End WithApplication.ScreenUpdating = TrueExit SubERRmsg: MsgBox "planilha não encontrada"  Application.ScreenUpdating = TrueEnd Sub

[Fabiano Martinss]

Olá osvaldo 

Desculpe a demora

 

Aqui esta o link para a planilha https://www.sendspace.com/file/ruwvy2

 

 

O  código do post acima não funcionou sempre aparece a mensagem "planilha não encontrada".

Porém, acho que já vai atender ao objetivo proposto da maneira que coloquei. Dá uma olhada, qualquer sugestão será bem vinda.

 

Coloquei mais dois códigos em cada uma das abas "a contar" preciso de ajuda com eles!

Quero que estes códigos anotem a data da ultima alteração.

No primeiro ele esta anotando a data somente se a célula estiver vazia logo se tiver alguma alteração a data não é alterada.

No segundo não consegui fazer anotar a data.

 

 

Valeu