VBA Copiar Intervalo (Plan3) e Colar no Inicio da (Plan1)

[Mathmatic]

Saudações Pessoal,

segue planilha em anexo,

Assunto:

preciso de um código VBA para copiar um Intervalo de valores da coluna A (Plan3) e colá-los (somente valores) logo no início da Coluna A (Plan1), conforme planilha em anexo.

Obs1: O Intervalo de valores da Col A Plan3 poderá iniciar em qualquer célula da Coluna A, ou seja, nem sempre iniciará na célula A7 da Plan3 conforme o anexo.

Obs2: O Tamanho do Intervalo a ser copiado também poderá variar, ou seja, nem sempre será de A7 até A12 conforme o anexo.

Exemplo: Poderia ser de A5 até A19 ou Poderia ser de A8 até A37 , etc...

Então preciso conseguir um código VBA para copiar o Intervalo existente na Col A da Plan3 e Colá-lo logo no Início (célula A1) da coluna A da Plan1 , conforme está no anexo.


desde já agradeço aos senhores.

[Wagner.cwb]

Olá Colega,

senti falta de um detalhe, quais sãos os outros valores possíveis coluna A (Plan3)?
Só vazios e os de interesse?

Supondo somente estes, você pode tentar gravar uma macro que filtre os valores do seu interesse e depois
faz a seleção dos mesmos para copiar e colar na folha destino.

[Mathmatic]

Olá Wagner,

sim, somente o bloco dos vazios antes do bloco dos Valores e depois então o bloco (range) dos Valores, conforme exemplifiquei na Col A da Plan3.

Não vai ser possível gravar Macro, por que como já expliquei, o bloco (range) dos Valores pode mudar de posição dentro da Col A, e também variar o tamanho do bloco (range) dos Valores.

o caso do Filtro "não" é viável na situação em que estou trabalhando. Somente um código VBA poderá me ajudar nesta situação.

preciso que o VBA copie o bloco (range) da Col A (Plan3) e cole valores no início da Col A (Plan1), conforme o anexo que enviei.


desde já sou agradecido.

[Wagner.cwb]

Boa noite colega!

bom, tentei criar um código, espero que lhe ajude.
Realmente o filtro não vai te ajudar.
entao eu fiz um contador para identificar a primeira linha preenchida e depois selecionar e copiar
a sequencia consecutiva encontrada, ou seja, se existirem lacunas, não irá funcionar...
Bom, eu sou novato, pode existir N formas de fazer.

Abraços!

Código: Selecionar todos

Sub Copiar_colar()
'
' encontrar primeira linha preenchida coluna A e selecionar até a ultima
'
Dim i As Integer

'iniciar busca pela primeira linha preenchida
'i = linha

i = 1
Sheets("Plan3").Select
Range("A1").Activate

Do While Range("A" & i).Value = 0
i = i + 1

Range("A" & i).Activate

Loop

'selecionando até a ultima linha preenchida em sequencia
Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
'transferindo para a  plan1
Sheets("Plan1").Select
Range("A1").Activate
ActiveSheet.Paste

End Sub

segue o arquivo com o módulo já criado.

[Mathmatic]

Wagner,

muito obrigado pelo seu interesse em querer me ajudar.

já ajudou um pouco na busca da uma solução ótima.

está faltando resolver "exatamente" para funcionar também no caso de "haver/existir" lacunas, ou seja, existir linha vazia entre os valores do Intervalo da Col A (Plan3).

vou pesquisar para ver se consigo adaptar para o caso de também haver/existir linhas vazias no meio do Intervalo Col A (Plan3).

muito obrigado amigo.

[Wagner.cwb]

Boa noite!

tente desse jeito:

Código: Selecionar todos

Sub Copiar_colar()
'
' encontrar primeira linha preenchida coluna A e selecionar até a ultima
'

'
Dim i As Integer

'iniciar busca pela primeira linha preenchida
'i = linha

Columns("A:A").Select
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Add Key:=Range("A7:A38"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan3").Sort
        .SetRange Range("A1:A65536")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


i = 1
Sheets("Plan3").Select
Range("A1").Activate

Do While Range("A" & i).Value = 0
i = i + 1

Range("A" & i).Activate

Loop

'selecionando até a ultima linha preenchida em sequencia
Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
'transferindo para a  plan1
Sheets("Plan1").Select
Range("A1").Activate
ActiveSheet.Paste

End Sub

Só colar o código naquele módulo que já roda.
Pensei assim, classificar a coluna toda e depois copia.

Outra coisa que não ficou claro para mim é se voce precisa manter a plan3 intacta?
Pois desse modo irá modificá-la.

Para solucionar isso, precisamos saber se existe o comando desfazer para vba, estou pesquisando
a respeito, mas não encontrei algo que passe pelos meus testes.
Abraços!

[Wagner.cwb]

Pensei um pouco mais kkkk

bom, pelo que pesquisei, não existe em vba o comando desfazer (ctrl+z), aí pensei, vamos copiar a coluna A em uma coluna "auxiliar" (AA),
assim ela armazena temporariamente a coluna original A e no fim cola (ctrl +x) na coluna A.


Veja aí se ajuda:

Código: Selecionar todos

Sub Copiar_colar()
'
' encontrar primeira linha preenchida coluna A e selecionar até a ultima
'

'
Dim i As Integer

'iniciar busca pela primeira linha preenchida
'i = linha
Sheets("Plan3").Select
Range("A1").Activate

    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("AA:AA").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan3").Sort.SortFields.Add Key:=Range("A7:A65536"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan3").Sort
        .SetRange Range("A1:A65536")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


i = 1
Sheets("Plan3").Select
Range("A1").Activate
Do While Range("A" & i).Value = 0
i = i + 1

Range("A" & i).Activate

Loop

'selecionando até a ultima linha preenchida em sequencia
Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
'transferindo para a  plan1
Sheets("Plan1").Select
Range("A1").Activate
ActiveSheet.Paste

Sheets("Plan3").Select
Range("A1").Activate
Columns("AA:AA").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste

Sheets("Plan1").Select
Range("A1").Activate

End Sub

[Mathmatic]

tópico [RESOLVIDO]

Parabéns Wagner,

Vc encontrou uma solução para o problema. Funcionou perfeitamente.

muito obrigado por sua atenção amigo.

[Wagner.cwb]

Fico contente por isso, sempre bom aprender e ajudar ao mesmo tempo.

Abraços!

[Swrain]

Olá

Cheguei nesse tópico pq é algo bem parecido com o que eu preciso, mas não é exatamente igual rs

Preciso de uma macro que, quando a aciono, ela copia um intervalo pré-estabelecido fixo (exemplo: celulas A1 até A20) e cola apenas os valores copiados (não a formatação da célula, então seria um "colar especial") em um outro local, de mesmo tamanho (exemplo: cola especial o conteúdo copiado nas células B1 a B20).

Detalhe: a aba (pasta de trabalho) de origem é diferente da destino.

Alguém consegue pensar em uma fórmula para essa macro? rs

Vlw!