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

Respuesta
1

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")
Next

Se 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

.

Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas