Consulta VBA - adaptando código existente

Question

Eu encontrei um pouco de VBA que está me ajudando a fazer o que eu quero fazer, o 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 uma linha por quatro colunas?

    

Answer 1

Eu prefiro 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

    

Answer 2

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