Notifications
Clear all
2024 - VBA & Macros
3
Posts
2
Usuários
1
Reactions
1,207
Visualizações
Topic starter
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
Postado : 16/06/2022 3:03 pm
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
Osvaldo
Postado : 16/06/2022 4:57 pm
JSCOPA10 reacted
Topic starter
@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
Postado : 16/06/2022 10:02 pm