☰

Consulta VBA - adaptando código existente

tag-icon • tag-icon microsoft-excel vba
Consulta VBA - adaptando código existente

Encontrei um pouco de VBA que está me ajudando a fazer o que quero, que inclui o seguinte:

With ThisWorkbook.Sheets(TargetSh) 
NxtEmptyRw = .Cells(65536, 1).End(xlUp).Row + 1 
.Cells(NxtEmptyRw, 1).Value = ActiveWorkbook.Sheets(SourceSh).Range("C2").Value 
.Cells(NxtEmptyRw, 2).Value = ActiveWorkbook.Sheets(SourceSh).Range("C3").Value 
.Cells(NxtEmptyRw, 3).Value = ActiveWorkbook.Sheets(SourceSh).Range("G2").Value 
.Cells(NxtEmptyRw, 4).Value = ActiveWorkbook.Sheets(SourceSh).Range("G3").Value 
End With 
End Sub

Como eu adaptaria a linha referente a G2, para que ela retornasse o valor abaixo de C2, em vez de continuar na mesma linha - criando efetivamente uma tabela de duas linhas por duas colunas, em vez de uma tabela de uma linha por quatro colunas?

Responder1

Eu preferiria uma solução mais curta como esta:

With ThisWorkbook.Sheets(TargetSh) 
  NxtEmptyRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 
  ActiveWorkbook.Sheets(SourceSh).Range("C2:C3,G2:G3").Copy
  .Cells(NxtEmptyRw, 1).PasteSpecial xlPasteValues, , , True
End With

Responder2

Substituir:

.Cells(NxtEmptyRw, 1).Value = ActiveWorkbook.Sheets(SourceSh).Range("C2").Value 
.Cells(NxtEmptyRw, 2).Value = ActiveWorkbook.Sheets(SourceSh).Range("C3").Value 
.Cells(NxtEmptyRw, 3).Value = ActiveWorkbook.Sheets(SourceSh).Range("G2").Value 
.Cells(NxtEmptyRw, 4).Value = ActiveWorkbook.Sheets(SourceSh).Range("G3").Value

com:

.Cells(NxtEmptyRw, 1).Value = ActiveWorkbook.Sheets(SourceSh).Range("C2").Value 
.Cells(NxtEmptyRw, 2).Value = ActiveWorkbook.Sheets(SourceSh).Range("C3").Value 
.Cells(NxtEmptyRw + 1, 1).Value = ActiveWorkbook.Sheets(SourceSh).Range("G2").Value 
.Cells(NxtEmptyRw + 1, 2).Value = ActiveWorkbook.Sheets(SourceSh).Range("G3").Value

informação relacionada