Macro Excel: Copiar renglón por renglón a otra hoja
Necesito copiar renglón(fila) por renglón de columna M:S de la hoja "NC" a la hoja "CTRL".
El motivo de copiar renglón por renglón es debido a que no se sabe cuantos filas copiare, es decir copiar hasta que la siguiente renglón no tenga datos o bien he puesto una una celda que cuente cuantas filas debe de copiar (MAX REN:$S$4).
Actualmente tengo el siguiente código vba más sin embargo solo copia el primer renglón la misma cantidad de renglones.
------------------------------------------------------------------------------------------------------------------------------------------
Sub GUARDAR_DATOS()
' GUARDAR_DATOS Macro
Dim RENGLON As Integer
RENGLON = Sheets("NC").Range("S2").Value
For I = 1 To RENGLON
fila = Application.WorksheetFunction.CountA(Worksheets("CTRL").Range("A:A")) + 1
Worksheets("CTRL").Cells(fila, 1) = Worksheets("NC"). Range("M11")
Worksheets("CTRL").Cells(fila, 2) = Worksheets("NC"). Range("N11")
Worksheets("CTRL").Cells(fila, 3) = Worksheets("NC"). Range("O11")
Worksheets("CTRL").Cells(fila, 4) = Worksheets("NC"). Range("P11")
Worksheets("CTRL").Cells(fila, 5) = Worksheets("NC"). Range("Q11")
Worksheets("CTRL").Cells(fila, 6) = Worksheets("NC"). Range("R11")
Worksheets("CTRL").Cells(fila, 7) = Worksheets("NC"). Range("S11")
Next
For I = 1 To RENGLON
If I = RENGLON Then
MsgBox ("REGISTROS GUARDADOS")
Else
Sheets("NC").Select
Range("M11:R11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CALCULO").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("BBDD").Select
Range("A4:D7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("T3582").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("NC").Select
End If
Next
End Sub
2 Respuestas
Te copia el mismo renglón porque en este ciclo, siempre pone las celdas M11, N11, O11, P11, Q11, R11 y S11
Sub GUARDAR_DATOS()
' GUARDAR_DATOS Macro
Dim RENGLON As Integer
RENGLON = Sheets("NC").Range("S2").Value
For I = 1 To RENGLON
fila = Application.WorksheetFunction.CountA(Worksheets("CTRL").Range("A:A")) + 1
Worksheets("CTRL").Cells(fila, 1) = Worksheets("NC"). Range("M11")
Worksheets("CTRL").Cells(fila, 2) = Worksheets("NC"). Range("N11")
Worksheets("CTRL").Cells(fila, 3) = Worksheets("NC"). Range("O11")
Worksheets("CTRL").Cells(fila, 4) = Worksheets("NC"). Range("P11")
Worksheets("CTRL").Cells(fila, 5) = Worksheets("NC"). Range("Q11")
Worksheets("CTRL").Cells(fila, 6) = Worksheets("NC"). Range("R11")
Worksheets("CTRL").Cells(fila, 7) = Worksheets("NC"). Range("S11")
NextSe puede cambiar el 11 por una variable, que empiece en 11 y vaya incrementando cada ciclo, por ejemplo:
Sub GUARDAR_DATOS()
' GUARDAR_DATOS Macro
RENGLON = Sheets("NC").Range("S2").Value
n = 11 'fila inicial de la hoja NC
For i = 1 To RENGLON
fila = Application.WorksheetFunction.CountA(Worksheets("CTRL").Range("A:A")) + 1
Worksheets("CTRL").Cells(fila, 1) = Worksheets("NC").Range("M" & n)
Worksheets("CTRL").Cells(fila, 2) = Worksheets("NC").Range("N" & n)
Worksheets("CTRL").Cells(fila, 3) = Worksheets("NC").Range("O" & n)
Worksheets("CTRL").Cells(fila, 4) = Worksheets("NC").Range("P" & n)
Worksheets("CTRL").Cells(fila, 5) = Worksheets("NC").Range("Q" & n)
Worksheets("CTRL").Cells(fila, 6) = Worksheets("NC").Range("R" & n)
Worksheets("CTRL").Cells(fila, 7) = Worksheets("NC").Range("S" & n)
n = n + 1 'se incrementa n para toma la siguiente fila
Next
'
'...O simplemente copiar el rango, de la siguiente manera, no es necesario el ciclo:
Sub GUARDAR_DATOS_2()
' GUARDAR_DATOS Macro
Sheets("NC").Range("M11:S" & Sheets("NC").Range("M" & Rows.Count).End(xlUp).Row).Copy
Sheets("CTRL").Range("A" & Sheets("CTRL").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlValues
'...
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Este es el resultado de la macro que esta debajo de la imagen, sin importar cuantos renglones añadas o quites la macro se adaptara al cambio.
y esta es la macro que buscas
Sub copiar_filas()
Set datos = Worksheets("nc").Range("m10").CurrentRegion
With datos
filas = .Rows.Count: columnas = .Columns.Count
Set destino = Worksheets("ctrl").Range("a1").Resize(filas, columnas)
destino.ClearContents
End With
destino.Value = datos.Value
End Sub
Gracias por tu pronta respuesta. Si funciona más sin embargo ocupo que la información copiada en la pestaña "CTRL" se copie un renglón abajo del ultimo ya que la macro que me enviaste la guarda en el mismo lugar "a1".
En mi macro tenia el sig. código:
fila = Application.WorksheetFunction.CountA(Worksheets("CTRL").Range("A:A")) + 1
Intente aplicarlo en tu código pero no m funciono. ¿Me podrías ayudar?
Entonces prueba con esta macro te copiara el bloque completo abajo de la ultima línea
Sub copiar_filas()
Set ho = Worksheets("nc").Range("m10")
Set hd = Worksheets("ctrl").Range("a1")
Set datos = ho.CurrentRegion
With datos
filas = .Rows.Count
Set datos = .Rows(2).Resize(filas - 1): columnas = .Columns.Count
Set destino = hd.CurrentRegion: filas2 = destino.Rows.Count
Set destino = destino.Rows(filas2 + 1).Resize(filas - 1, columnas)
destino.Value = .Value
hd.Resize(1, columnas).Value = .Rows(0).Value
End With
End Sub