Anónimo
Macro de copia y Pega
Tengo una base de datos pegada en Excel y necesito copiar un rango de filas, en la siguiente fila.
Ejemplo
¿Tengo datos en las columnas a?... ¿i?
Necesito copiar esa fila completa y pegarla en la siguiente de abajo (que puede contener más filas, tendría que usar fin flecha abajo, pero ocasiones no) y pegarla en la que esta en blanco debajo de la que copie de arriba
Algo así:
a b c
Nombre apellidos dato1
Nombre apellidos dato1
(Celda en blanco) donde va los datos de la ultima de la misma fila dato1
luego viene otra serie
a b c
nombre apellidos dato2
nombre apellidos dato2
nombre apellidos dato2
nombre apellidos dato2
(Celda en blanco) donde va los datos de la ultima de la misma fila dato2
y así sucesivamente hasta la fila 45965, por lo cual, requiero algo que haga automático de copiar el rango de filas desde la a hasta la i y la pegue en la siguiente de abajo de esa misma fila en blanco hasta la fila ya antes mencionada, espero me puedas ayudar
Gracias
Ejemplo
¿Tengo datos en las columnas a?... ¿i?
Necesito copiar esa fila completa y pegarla en la siguiente de abajo (que puede contener más filas, tendría que usar fin flecha abajo, pero ocasiones no) y pegarla en la que esta en blanco debajo de la que copie de arriba
Algo así:
a b c
Nombre apellidos dato1
Nombre apellidos dato1
(Celda en blanco) donde va los datos de la ultima de la misma fila dato1
luego viene otra serie
a b c
nombre apellidos dato2
nombre apellidos dato2
nombre apellidos dato2
nombre apellidos dato2
(Celda en blanco) donde va los datos de la ultima de la misma fila dato2
y así sucesivamente hasta la fila 45965, por lo cual, requiero algo que haga automático de copiar el rango de filas desde la a hasta la i y la pegue en la siguiente de abajo de esa misma fila en blanco hasta la fila ya antes mencionada, espero me puedas ayudar
Gracias
1 respuesta
Respuesta de blooddragon
1
Haciendo algunas modificaciones a este código puedes obtener los resultados que quieres
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja3").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
Solo agregarias este codigo para activar los libros
Workbooks("Tabla Sin Fondos.xls").Activate
Sub copia_valores()
On Error GoTo EH
Dim NHoja As String
Dim Val As Variant
Dim i, j As Integer
ActiveWorkbook.Sheets("Hoja1").Activate
ActiveSheet.Cells(1, 1).Activate
i = 1
While ActiveCell.Value <> ""
i = i + 1
If ActiveCell.Value > 85 Then
ActiveCell.Select
Selection.Copy
Sheets("Hoja3").Select
j = ActiveCell.Row
While ActiveCell.Value <> ""
j = j + 1
ActiveSheet.Cells(j, 1). Activate
Wend 'While ActiveCell <> ""
ActiveSheet.Paste
ActiveWorkbook.Sheets("Hoja1").Activate
End If 'If ActiveCell.Validation > 85 Then
ActiveSheet.Cells(i, 1).Activate
Wend 'While ActiveCell.Value <> ""
Exit Sub
EH:
Select Case Err.Number
Case 1004:
Resume Next
Case Else:
MsgBox Err.Number & "-" & Err.Description
End Select
End Sub
Solo agregarias este codigo para activar los libros
Workbooks("Tabla Sin Fondos.xls").Activate