Macro para copiar datos de una tabla a otra con loop / bucle

Tengo un tabla, donde debo hacer una carta por cada línea de la tabla. He logrado hacer pero solo se me copia los datos de la primera línea.

Lo que tengo es:

Dim x As Integer
      ' Establecer numrows = número de filas de datos.
      NumRows = Range("A9", Range("A9").End(xlDown)).Rows.Count
      ' Seleccionar celda a1.
      Range("A9").Select
      ' Establecer valor "For" para que vaya de bucle el bucle durante "numrows" veces.
      For x = 1 To NumRows
      ActiveCell.Offset(1, 0).Select
    Range("B9").Select
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("J3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("B3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("E35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("J35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("F9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("C28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("G9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("C26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("H9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("C30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Almacen").Select
    Range("I9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CSC - 1").Select
    Range("C14").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'IMPRIMIR
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
         ' Selecciona la celda 1 fila por debajo de la celda activa.
         ActiveCell.Offset(1, 0).Select
      Next
     

End Sub

Lo que necesito es que se repita el proceso, pero copiando los datos de la línea 10... 11... 12... 13 hasta que no haya datos en la columna A.

¿Es posible?

1 respuesta

Respuesta
1

Si no tiene celda en blanco hasta la ultima fila con datos

puedes usar do while

seria asi

Do while activecell <> ""

ActiveCell.Offset(0, 1). Copy
Sheets("sheet2"). Range("a2"). PasteSpecial xlPasteValues

loop

Donde offset seria la columna B

Sheet2 seria el nombre la hoja donde quiere copier el dato en tu caso seria CSC-1

No olvides valorar si te silve y no sales a camino no duces en preguntar

Hola Aneudys,

Muchas gracias por tan pronta respuesta!!!! Pero, desafortunadamente no me funciona...

Te explicaré un poco la dinámica de lo que necesito. La Hoja "CSC-1" es un template de una carta, con datos datos de la hoja "Almacen". Lo que me gustaría es imprimir una carta con los datos de cada una de las líneas de la hoja "Almacen", por eso me gustaría saber como repetir el proceso de copiar y pegar la info de una hoja a la otra.

Gracias!!!!

Solo puse in ejemplo de como tiene que hacde para pegar cada dato

Este es mi correo para crear el procedimiento completo

[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas