Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
AJUSTE DE UMA MACRO
 
Notifications
Clear all

[Resolvido] AJUSTE DE UMA MACRO

 
2024 - VBA & Macros
Post Recente por JSCOPA10 3 anos atrás
3 Posts
2 Usuários
1 Reactions
1,160 Visualizações
RSS
JSCOPA10
 JSCOPA10
(@jscopa10)
Posts: 344
Reputable Member
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
 Osvaldomp
(@osvaldomp)
Posts: 860
Prominent Member
 

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
JSCOPA10
 JSCOPA10
(@jscopa10)
Posts: 344
Reputable Member
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
Forum Jump:
  Tópico Anterior
Próximo Tópico