Notifications
Clear all

Loop copiar e colar

8 Posts
1 Usuários
0 Reactions
3,155 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Pessoal preciso de um loop para copiar a celula A1 da plan1 e colar na plan2 coluna A, detalhe até aonde houver dados na coluna B da plan2.
O problema esta em identificar até aonde existe dados na coluna b uma vez que os mesmos irão variar.
Poderam observar que estou copiando os valores da plan1 para plan2, falta so o detalhe de copiar somente a celula A1 e lançar na coluna A da plan2
Segue o codigo que estou utilizando :

Sub TransfereD()

Sheets("plan1").Select
If Range("A1").Value = "" Then

        MsgBox "Faltou digitar o número da solicitação", vbCritical, "Cadastro"
        Exit Sub
    
Else

Sheets("plan1").Select
Range("$A$4:$l$1000").Select ' estas linhas não são fixas podem variar
Selection.Copy

Sheets("plan2").Select
L = Sheets("plan2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("B" & L).Select

        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    
End If

'codigo para copiar celula A1 da plan1, para todas as linhas da plan2 na coluna A enquanto houver valor na coluna b



End Sub
 
Postado : 08/05/2012 4:55 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

geroeane, ficou um pouco confuso a solicitação com a rotina que postou, mas se quer um código para :
"codigo para copiar celula A1 da plan1, para todas as linhas da plan2 na coluna A enquanto houver valor na coluna b"

Utilize a seguinte rotina :

Sub TransferePlan1pPlan2()

    Sheets("plan1").Select
    
    If Sheets("plan1").Range("A1").Value = "" Then

            MsgBox "Faltou digitar o número da solicitação", vbCritical, "Cadastro"
            Exit Sub
       
    Else
    
        'COPIA SOMENTE A CELUA A1
        Sheets("plan1").Range("A1").Copy
    
        'CONTA OS ITENS NA COLUNA B PLAN2
        L = Sheets("plan2").Cells(Rows.Count, 2).End(xlUp).Row
    
        'COLA NA COLUNA A PLAN2 CONFORME A QDE NACOLUNA B
        Sheets("plan2").Range("A1:A" & L).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False
       
    
End If

[]s

 
Postado : 08/05/2012 5:28 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bo a noite!!

segue um exemplo

Sub Copiar()
Dim r As Range, r1 As Range

With Worksheets("Origem")
 Set r = .Cells(Rows.Count, "A").End(xlUp)
End With

With Worksheets("Destino")
 Set r1 = .Cells(Rows.Count, "A").End(xlUp)
End With

r.EntireRow.Copy r1.Offset(1, 0)
End Sub
 
Postado : 08/05/2012 5:31 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

mauro, boa noite e quase isso seu codigo beleza, so tem um detalhe vou anexar a planilha talvez fique mais facil entender....

Resumindo caso ja tenha valores na plan2 ele devera começar a colar apartir destes ultimos dados. bem segue em anexo, vou dar uma mexida em codigo para ver se consigo adaptar....

 
Postado : 08/05/2012 6:09 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Quase consegui... o codigo ficou assim:
So que desta maneira ele não preenche todas as linhas da coluna A, ele preenche a ultima celula dos dados.
Por enquanto supre minha necessidade se algume tiver alguma ideia agradeço, para colocar todas as linhas.

Sub TransfereD()

Sheets("plan1").Select
If Range("A1").Value = "" Then

        MsgBox "Faltou digitar o número da solicitação", vbCritical, "Cadastro"
        Exit Sub
    
Else

Sheets("plan1").Select
Range("$A$4:$l$1000").Select ' estas linhas não são fixas podem variar
Selection.Copy

    Sheets("plan2").Select
    L = Sheets("plan2").Cells(Rows.Count, 2).End(xlUp).Row + 1
    Range("B" & L).Select

        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    
    
    
End If

TransferePlan1pPlan2

End Sub

Sub TransferePlan1pPlan2()

       
        'COPIA SOMENTE A CELUA A1
        Sheets("plan1").Range("A1").Copy
    
        'CONTA OS ITENS NA COLUNA B PLAN2
    Sheets("plan2").Select
    L = Sheets("plan2").Cells(Rows.Count, 2).End(xlUp).Row
    Range("A" & L).Select
    
       Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    

End Sub
 
Postado : 09/05/2012 5:22 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

mauro, boa noite e quase isso seu codigo beleza, so tem um detalhe vou anexar a planilha talvez fique mais facil entender....

Resumindo caso ja tenha valores na plan2 ele devera começar a colar apartir destes ultimos dados. bem segue em anexo, vou dar uma mexida em codigo para ver se consigo adaptar....

Geroane, não entendi, testei o código que está em seu anexo e é justamente isto o que ele faz, copia os dados da Plan1 e Cola na Plan2 a partir da última célula preenchida na Coluna B da plan2.

:?: :?:

[]s

 
Postado : 09/05/2012 6:07 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Mauro justo, mas veja se eu precisar alterar a solicitação para outro valor em A1 e filtrar novos valores, gostaria que os dados que foram enviados na plan2 continuassem la e estes dados vossem lançados abaixo dos que la existem,Beleza com o prrmeiro codigo consigo enviar abaixo dos dados antigos mas com o seu codigo ele começa de a3 matando todas as outras informações, preciso que entenda na planilha 2 na coluna A as celulas vazias poderam estar em A3 ou A100.

Fiz uma gambiara, por enquando consigo virar-me, mas gosto de aprender e ver sempre o melhorar o processo de excução das minhas macros.

Se consegui fazer-me entender e você tiver uma dica agradeço, qualquer coisa seu codig oja foi de grande ajuda...

 
Postado : 10/05/2012 7:46 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Pessoal adaptando o codigo inicial mais a sugestão do mauro consegui resolver o problema copiando os dados para uma terceira planilha.
Agradeço as colaborações....

 
Postado : 10/05/2012 3:57 pm