Repetir tantas filas como marcas hay

Tengo una fila con un Cód y tres columnas con unas marcas. Necesito que de esta fila cree un fichero nuevo con el Cód y tantas filas como marcas hay.

Adjunto una imagen

2 Respuestas

Respuesta
2

Puedes responder lo siguiente:

  • ¿Solamente es una fila?
  • ¿En cuál fila de excel está tu fila?
  • ¿En cuál columna empiezan las marcas?
  • "cree un fichero" supongo que te refieres a un archivo nuevo. En cuál carpeta lo va a guardar, ¿cómo se va a llamar el archivo?
  • ¿En cuáles columnas quieres el resultado?

1ª Son todas las filas que tengo en un listado

2ª Te mando una imagen donde creo se explica mejor

3ª En la imagen que te mando te indico en que columna empiezan las marcas

4ª Si se tiene que generar un fichero nuevo a partir de este

En la imagen no se ven ni las filas ni las columnas de excel.

Podrías responder lo siguiente y en este orden:

  1. ¿Solamente es una fila?
  2. ¿En cuál fila de excel está tu fila?
  3. ¿En cuál columna empieza la fila?
  4. ¿En cuál columna empiezan las marcas?
  5. "cree un fichero" supongo que te refieres a un archivo nuevo. En cuál carpeta lo va a guardar, ¿cómo se va a llamar el archivo?
  6. ¿En cuáles columnas quieres el resultado?
  7. ¿En cuál fila quieres que inicie el resultado?
  8. ¿Quieres encabezado en el archivo nuevo?
  9. ¿De dónde obtengo el encabezado?
  1. ¿Solamente es una fila?

Todas las filas del listado A

  1. ¿En cuál fila de excel está tu fila?

La primera fila con datos esta en C2 y el encabezado en C1

  1. ¿En cuál columna empieza la fila?     C2
  2. ¿En cuál columna empiezan las marcas?  G2
  3. "cree un fichero" supongo que te refieres a un archivo nuevo. En cuál carpeta lo va a guardar, ¿cómo se va a llamar el archivo?

Se guarda en el mismo libro de Excel el fichero nuevo de debe generar en una hoja nueva

  1. ¿En cuáles columnas quieres el resultado? Al principio de la hoja

  1. ¿En cuál fila quieres que inicie el resultado?   A
  2. ¿Quieres encabezado en el archivo nuevo?   Si
  3. ¿De dónde obtengo el encabezado?   Te lo he marcado en la nueva imagen que te mando

Pon tu información en la hoja1, el resultado en la hoja2

Prueba esto:

Sub Repetir_Filas()
  Dim a As Variant, i As Long, j As Long, k As Long
  a = Sheets("Hoja1").Range("C2:I" & Sheets("Hoja1").Range("C" & Rows.Count).End(3).Row).Value2
  '
  ReDim b(1 To UBound(a) * 3, 1 To 5)
  For i = 1 To UBound(a, 1)
    For j = 5 To 7
      If a(i, j) <> "" Then
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 2)
        b(k, 3) = a(i, 3)
        b(k, 4) = a(i, 4)
        b(k, 5) = a(i, j)
      End If
    Next
  Next
  Sheets("Hoja2").Range("A:E").ClearContents
  Sheets("Hoja2").Range("A1:D1").Value = Sheets("Hoja1").Range("C1:F1").Value
  Sheets("Hoja2").Range("A2").Resize(k, 5).Value = b
End Sub

Buenas.

Agradezco tu respuesta en esta ocasión si me ha funcionado. Me podrías dar una explicación por línea para poder entenderlo y si necesito hacer alguna modificación poder hacerlo yo mismo, es posible que en lugar de 3 marcas necesite más esto era solo un ejemplo, o quizás modifique más columnas. ¿Para ejecutar esto es necesario siempre acceder a VBA y ejecutar? ¿Se puede hacer de alguna otra manera?

Insisto en agradecerte tu tiempo y respuesta, esto es algo que me trae loco y tengo que solucionarlo para poder seguir en mi proyecto.

Gracias.

Para que funcione con más marcas tengo que cambiar algunas cosas en la macro. Dame oportunidad de hacer los cambio y en la nueva macro te explico cada línea.

Buenas.

Te agradezco tu tiempo a mi problema y decirte que cuando puedas, la respuesta es lo importante no el tiempo. Me interesa mucho saber como funciona cada línea para poder interpretar.

Gracias

Prueba la siguiente:

Sub Repetir_Filas()
  'Declaración de variables
  Dim a As Variant, i As Long, j As Long, k As Long
  Dim lr As Long, lc As Long
  '
  With Sheets("Hoja1")
    'obtiene la última fila con datos de la columna C
    lr = .Range("C" & Rows.Count).End(3).Row
    'obtiene la última columna con datos de la fila 1
    lc = .Cells(1, Columns.Count).End(1).Column
    a = .Range("C2", .Cells(lr, lc)).Value2
  End With
  '
  'Redimensiona el arreglo 'b' para almacenar los resultados
 'va desde la fila 1 hasta la ultima fila * el número de columnas
 'y de 1 a 5 columnas
 'si tienes 5 filas y 3 columnas, entonces el arreglo posiblemente
 'tendrá 15 filas por 5 columnas.
  ReDim b(1 To UBound(a) * lc, 1 To 5)
  'Ciclo para cada fila
  For i = 1 To UBound(a, 1)
    'Ciclo de la columna 5 hasta la última columna
 'la columna 1 es la columna C
 'la columna 5 es la columna G donde empiezan las marcas
 'por eso el ciclo empieza en 5
    For j = 5 To lc - 2
      'si marca de la fila columna es diferende de vacío entonces lo guarda en el arregl
      If a(i, j) <> "" Then
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 2)
        b(k, 3) = a(i, 3)
        b(k, 4) = a(i, 4)
        b(k, 5) = a(i, j)
      End If
    Next
  Next
  With Sheets("Hoja2")
    'limpia las columnas
    .Range("A:E").ClearContents
    'pone encabezados
    .Range("A1:D1").Value = Sheets("Hoja1").Range("C1:F1").Value
    'pone el arreglo b en la hoja2 empezando en la celda a2
    'cambie el tamaño al número de filas alcanzadas en la variable k y 5 columnas
    .Range("A2").Resize(k, 5).Value = b
  End With
End Sub

Buenas.

Como tengo que hacer para que en lugar de empezar el listado en la celda "A1" empiece en la celda "D5"

Todo lo demás es correcto. Una pregunta, no entiendo muy bien si esta limitado el numero de marcas o no y si esta limitado a cuantas.

Gracias. 

Como tengo que hacer para que en lugar de empezar el listado en la celda "A1" empiece en la celda "D5"

  With Sheets("Hoja2")
    'cambie el tamaño al número de filas alcanzadas en la variable k y 5 columnas
    .Range("D5").Resize(k, 5).Value = b
  End With

Todo lo demás es correcto. Una pregunta, no entiendo muy bien si esta limitado el numero de marcas o no y si esta limitado a cuantas.

No está limitado en el código, pero el límite sería le número de columnas de la hoja de excel.

Respuesta
2

Este es el resultado de la macro

y esta es la macro

Sub copia()
Set datos = Range("b3").CurrentRegion
With datos
    col = .Columns.Count: filas = .Rows.Count
    Set clona = .Cells(2, 4).Resize(1, col - 3)
  Set destino = .Rows(filas + 3).Resize(col - 3, 4)
  destino.Select
End With
With destino
    .Clear
    .Columns(1).Value = datos.Cells(2, 1).Value
    .Columns(2).Value = datos.Cells(2, 2).Value
    .Columns(3).Value = datos.Cells(2, 3).Value
    For i = 1 To col - 3
        .Cells(i, 4) = clona.Cells(1, i)
    Next i
End With
Set datos = Nothing: Set clona = Nothing: Set destino = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas