Anónimo
Registrar por bloques hasta la columna "E"
Tengo en la Hoja1 una tabla con registros desde la col. A hasta la col. E. La macro pasa los registros en bloques a la Hoja2 , pero en línea.
Lo que quiero es que cuando complete la col. E. Continúe debajo, dejando una fila libre. Es decir, a partir de la fila 7.
Sub Prueba()
Dim Lab As Worksheet
Dim Ads As Worksheet
Set Lab = Worksheets("Hoja2")
Lab.Cells.ClearContents
Lab.Cells(1, 1).ColumnWidth = 22
Lab.Cells(1, 2).ColumnWidth = 22
Lab.Cells(1, 3).ColumnWidth = 22
Lab.Cells(1, 4).ColumnWidth = 22
Lab.Cells(1, 5).ColumnWidth = 22
Set Ads = Worksheets("Hoja1")
uFila = Ads.Cells(65536, 1).End(xlUp).Row
If uFila > 1 Then
NR = 1
NC = 1
For i = 2 To uFila
If NC = 1 Then
Lab.Cells(NR, 1).Resize(4, 1).RowHeight = 16
End If
nFila = NR
Lab.Cells(nFila, NC).Value = Ads.Cells(i, 1) '& " " & Ads.Cells(i, 7)
If Ads.Cells(i, 2).Value > "" Then
nFila = nFila + 1
Lab.Cells(nFila, NC).Value = Ads.Cells(i, 2)
End If
If Ads.Cells(i, 3).Value > "" Then
nFila = nFila + 1
Lab.Cells(nFila, NC).Value = Ads.Cells(i, 3)
End If
If Ads.Cells(i, 4).Value > "" Then
nFila = nFila + 1
Lab.Cells(nFila, NC).Value = Ads.Cells(i, 4)
End If
If Ads.Cells(i, 5).Value > "" Then
nFila = nFila + 1
Lab.Cells(nFila, NC).Value = Ads.Cells(i, 5)
End If
If NC >= 1 Then
NC = NC + 1
End If
Next i
End If
End Sub
1 Respuesta
Respuesta de James Bond
1
Esta es la pantalla con tus datos en la hoja 1
este es el resultado de la macro de la hoja 2
y esta es la macro
Sub COPIAR_DATOS()
Set HO = Worksheets("HOJA1")
Set Lab = Worksheets("HOJA2")
Set DATOS = HO.Range("A1").CurrentRegion
With DATOS
FILAS = .Rows.Count
Set DATOS = .Rows(2).Resize(FILAS - 1)
Set DESTINO = Lab.Range("A1").Resize(5, 5)
X = 1
For I = 1 To FILAS
NCOL = DESTINO.Columns(I).Column
If NCOL > 5 And X > 5 Then
Set DESTINO = DESTINO.CurrentRegion
FILAS = DESTINO.Rows.Count
Set DESTINO = DESTINO.Rows(FILAS + 2).Resize(FILAS, 5)
X = 1
End If
.Rows(I).Copy: DESTINO.Columns(X).PasteSpecial Transpose:=True
X = X + 1
Next I
End With
DESTINO.EntireColumn.AutoFit
End Sub