Ir ao conteúdo

Macro para copiar e colar valores de linhas especificas


Posts recomendados

Postado

Espero que vocês possam me ajudar, estou tentando criar uma macro para copiar linhas desta seleção 'Relatorio descarga'!G1:AF56 onde todas as células cotem formulas como esta =SE(ÉCÉL.VAZIA(Lançamento!F16);"";(Lançamento!F16)) ou similares que ficam em branco se não conter dados na célula de referencia, A questão e como criar uma macro que copia apenas os valores das formulas que me mostra um valor de referencia e colar na ultima linha de outra aba da planilha De uma olhada na planilha e vê o que vocês poder fazer desde já agradeço

Recebimento de açucar_amostra.xlsx.zip

Postado

Tiago, experimente o código abaixo e veja se entendi corretamente o que você deseja.

Sub CopiaColaValores() Dim LRo As Long, LRd As Long, cel As Range  With Sheets("Relatorio descarga")   LRo = .Cells(Rows.Count, 1).End(xlUp).Row    For Each cel In .Range("A1:A" & LRo)     If cel.Value <> "" Then      LRd = Sheets("Entrada").Cells(Rows.Count, 1).End(xlUp).Row      Sheets("Entrada").Cells(LRd + 1, 1).Resize(, 32).Value = cel.Resize(, 32).Value     End If    Next cel  End WithEnd Sub
Postado

Osvaldo e isto mesmo que eu estava querendo fazer e ficou perfeito o que você fez muito obrigado só mais uma coisa tem como você descrever a função de cada linha do código da macro e que tenho outros macros neste mesmo estilo para fazer ai poderei usar como base de aprendizagem a suas no demais só tenho agradecer

Postado

... só mais uma coisa tem como você descrever a função de cada linha do código ...

 

Aí vai o mesmo código com alguns comentários. Se quiser pode colocar no lugar do anterior pois os comentários não afetarão a sua execução. Ao colar no módulo os comentários ficarão com a fonte cor verde.

Sub CopiaColaValores() 'declaração de variáveis:  'LRo >> última linha com conteúdo na coluna "A" da planilha "Relatorio descarga"  'LRd >> última linha com conteúdo na coluna "A" da planilha "Entrada"  'cel >> no "Loop" será cada célula da coluna "A" da planilha "Relatorio descarga" Dim LRo As Long, LRd As Long, cel As Range      With Sheets("Relatorio descarga") 'trabalhando com a planilha "Relatorio descarga" (início)   LRo = .Cells(Rows.Count, 1).End(xlUp).Row 'retorna o número da última linha    For Each cel In .Range("A1:A" & LRo) 'início/sequência do "Loop" no intervalo ("A1:A & última linha)     If cel.Value <> "" Then 'verifica se o valor da célula é vazio (inclusive resultado de fórmula)      LRd = Sheets("Entrada").Cells(Rows.Count, 1).End(xlUp).Row 'retorna o número da última linha      Sheets("Entrada").Cells(LRd + 1, 1).Resize(, 32).Value = cel.Resize(, 32).Value 'cola o registro, _       cuja verificação retornar VERDADEIRA, na planilha "Entrada", de "A" até "AF"     End If 'fim da verificação    Next cel 'sequência/fim do "Loop"  End With 'trabalhando com a planilha "Relatorio descarga" (fim)End Sub

Retorne se não ficou satisfatório.

 

Postado

 Tenho uma outra planilha que tenho que fazer praticamente a mesma coisa mais com o range diferente quero mandar da aba  Pesquisa  B10:F54 (Obs.. Todos campos contem formulas igual esta que você fez para mim) serão sempre 5 colunas de B10 a F10 mais as linhas podem varias de B10 a B54 copiar apenas valores viziveis e colar em Saida A:E na ultima linha vazia, se você puder me ajudar fico grato.


Aí vai o mesmo código com alguns comentários. Se quiser pode colocar no lugar do anterior pois os comentários não afetarão a sua execução. Ao colar no módulo os comentários ficarão com a fonte cor verde.

Sub CopiaColaValores() 'declaração de variáveis:  'LRo >> última linha com conteúdo na coluna "A" da planilha "Relatorio descarga"  'LRd >> última linha com conteúdo na coluna "A" da planilha "Entrada"  'cel >> no "Loop" será cada célula da coluna "A" da planilha "Relatorio descarga" Dim LRo As Long, LRd As Long, cel As Range      With Sheets("Relatorio descarga") 'trabalhando com a planilha "Relatorio descarga" (início)   LRo = .Cells(Rows.Count, 1).End(xlUp).Row 'retorna o número da última linha    For Each cel In .Range("A1:A" & LRo) 'início/sequência do "Loop" no intervalo ("A1:A & última linha)     If cel.Value <> "" Then 'verifica se o valor da célula é vazio (inclusive resultado de fórmula)      LRd = Sheets("Entrada").Cells(Rows.Count, 1).End(xlUp).Row 'retorna o número da última linha      Sheets("Entrada").Cells(LRd + 1, 1).Resize(, 32).Value = cel.Resize(, 32).Value 'cola o registro, _       cuja verificação retornar VERDADEIRA, na planilha "Entrada", de "A" até "AF"     End If 'fim da verificação    Next cel 'sequência/fim do "Loop"  End With 'trabalhando com a planilha "Relatorio descarga" (fim)End Sub

Retorne se não ficou satisfatório.

Postado

Veja se atende.

Sub CopiaColaValores2() Dim LRd As Long, cel As Range  With Sheets("Pesquisa")    For Each cel In .Range("B10:B54")     If cel.Value <> "" Then      LRd = Sheets("Saida").Cells(Rows.Count, 1).End(xlUp).Row      Sheets("Saida").Cells(LRd + 1, 1).Resize(, 5).Value = cel.Resize(, 5).Value     End If    Next cel  End WithEnd Sub
Postado

 

Veja se atende.

Sub CopiaColaValores2() Dim LRd As Long, cel As Range  With Sheets("Pesquisa")    For Each cel In .Range("B10:B54")     If cel.Value <> "" Then      LRd = Sheets("Saida").Cells(Rows.Count, 1).End(xlUp).Row      Sheets("Saida").Cells(LRd + 1, 1).Resize(, 5).Value = cel.Resize(, 5).Value     End If    Next cel  End WithEnd Sub

Novamente era isto que queria fazer e ficou ate mais fácil para meu entendimento para adaptar a magro em outras planilhas pois agora mostra o range no código da macro, Muito obrigado!

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!