Notifications
Clear all

como posso estar fazendo isto com um macro?

2 Posts
2 Usuários
0 Reactions
885 Visualizações
(@wenpra)
Posts: 76
Estimable Member
Topic starter
 

Como Criar um Macro para copiar e colar?

Mensagempor wenpra » 24 Ago 2013, 08:16

Olá bom dia, eu tenho uma planilha com vários registros desta forma:

Coluna A
Linha1 Graficar Serviços Automotivos Ltda
Linha2
Linha3 r Nhu Guaçu, 311, Nova Piraju
Linha4 São Paulo - SP, 04625001
Linha5
Linha6
Linha7 Fone: (11) 50442188
Linha8
Linha9 Blindcar
Linha10
Linha11 av Interlagos, 2484, Jd Marajoara
Linha12 São Paulo - SP, 04660004
Linha13
Linha14
Linha15 Fone: (11) 55233296
Linha16
Linha17 Parucci Auto Mecânica Comércio Ltda
Linha18
Linha19 r José Neves, 621, Vl São Paulo
Linha20 São Paulo - SP, 04650141
Linha21
Linha22
Linha23 Fone: (11) 55242811

E gostaria de copiar esses dados acima para uma outra planilha mas que ficasse dessa forma:

_________Coluna A_____________________________Coluna B________________________Coluna C________________Coluna D
Linha1__Graficar Serviços Automotivos Ltda_______r Nhu Guaçu, 311, Nova Piraju______São Paulo - SP, 04625001__Fone: (11) 50442188
Linha2__Blindcar______________________________av Interlagos, 2484, Jd Marajoara___São Paulo - SP, 04660004__Fone: (11) 55233296
Linha3__Parucci Auto Mecânica Comércio Ltda_____r José Neves, 621, Vl São Paulo_____São Paulo - SP, 04650141__Fone: (11) 55242811

CASO NÂO CONSIGA COMPREENDER O QUE QUERO ESTOU POSTANDO TAMBEM UM MODELO EM ANEXO.

se alguém puder me ajudar agradeço, Tenha um bom dia e bom final de semana.

 
Postado : 26/08/2013 6:28 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se o lay out for sempre igual experimente:

Sub Copia()
Dim lRow As Long, x As Integer, uLin As Long
    lRow = Sheets("Plan1").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
    
For x = 1 To lRow Step 8
    Sheets("Plan1").Activate
    Range(Cells(x, 1), Cells(x + 7, 1)).Copy
    'Selection.Copy
    uLin = Sheets("Plan3").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Plan3").Activate
    Range("A" & uLin).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Next
Application.CutCopyMode = False
End Sub
 
Postado : 26/08/2013 7:52 am