AJUSTE DE UMA MACRO
 
Compartilhar:
Notifications
Clear all

[Resolvido] AJUSTE DE UMA MACRO


JSCOPA10
Posts: 348
Moderator
Topic starter
(@jscopa10)
Reputable Member
Entrou: 3 anos atrás

Meus caros, boa tarde.

Esta Macro funciona, mas acaba deixando os dados colados desalinhados!!

Gostaria que a referência para encontrar a última linha vazia fosse a coluna A (e não as colunas B, Q e W - estas seria só para a Macro saber onde colar)!!

Sub ultima_linha_inativos()

'MACRO1 -- copia este intervalo
Range("B3:L32").Copy


'vai até a linha B2000, sobe até a última célula preenchida, e desce 3 linhas
Range("B2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteFormats
Range("B2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteValues

'apaga a seleção inicial
Application.CutCopyMode = False

'===========================

'MACRO2 -- copia este intervalo
Range("Q3:R32").Copy


'vai até a linha Q2000, sobe até a última célula preenchida, e desce 3 linhas
Range("Q2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteFormats
Range("Q2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteValues

'apaga a seleção inicial
Application.CutCopyMode = False

'===========================

'MACRO3 -- copia este intervalo
Range("W3:X32").Copy


'vai até a linha W2000, sobe até a última célula preenchida, e desce 3 linhas
Range("W2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteFormats
Range("W2000").End(xlUp).Offset(3, 0).PasteSpecial xlPasteValues

'apaga a seleção inicial
Application.CutCopyMode = False

End Sub

 

Responder
2 Respostas
Osvaldomp
Posts: 532
Registered
(@osvaldomp)
Honorable Member
Entrou: 10 anos atrás

Olá, @jscopa10.

Veja se ajuda.

Sub ultima_linha_inativosV2()
Dim LR As Long, r As Range
LR = Range("B2000").End(xlUp).Row + 3
Application.ScreenUpdating = False
For Each r In Range("B3,Q3,W3")
r.Resize(30, 2 - 9 * (r.Column = 2)).Copy
Cells(LR, r.Column).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next r
Application.CutCopyMode = False
End Sub
Responder
JSCOPA10
Posts: 348
Moderator
Topic starter
(@jscopa10)
Reputable Member
Entrou: 3 anos atrás

@osvaldomp, funcionou, valeu!!!!!!!!!!!!!

Só tive que dividir a Cells em 2 (não estava colando formatos)!!

Sub ultima_linha_inativosV2()

Dim LR As Long, r As Range
LR = Range("b2000").End(xlUp).Row + 3
Application.ScreenUpdating = False
For Each r In Range("B3,Q3,W3")
r.Resize(30, 2 - 9 * (r.Column = 2)).Copy
Cells(LR, r.Column).PasteSpecial Paste:=xlPasteValues
Cells(LR, r.Column).PasteSpecial Paste:=xlPasteFormats
Next r
Application.CutCopyMode = False

End Sub
Responder
Compartilhar: