☰

Consulta VBA: adaptación del código existente

tag-icon • tag-icon microsoft-excel vba
Consulta VBA: adaptación del código existente

Encontré un poco de VBA que me ayuda a hacer lo que quiero hacer, que incluye lo siguiente:

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

¿Cómo adaptaría la línea que hace referencia a G2, para que devuelva el valor debajo de C2, en lugar de continuar en la misma fila, creando efectivamente una tabla de dos filas por dos columnas, en lugar de una tabla de una fila por cuatro columnas?

Respuesta1

Preferiría una solución más corta 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

Respuesta2

Reemplazar:

.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

con:

.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

información relacionada