Jump to content
Sign in to follow this  
eoscar88

Crear Base a partir de Tablas

Recommended Posts

Libro1-EJEMPLO.xlsx

Hola excelente día a todos, acudo nuevamente a este foro para solicitar de su apoyo, requiero crear una base a partir de varias tablas, en el archivo adjunto tengo como ejemplo dos hojas de calculo que dicen vales, y requiero que la información contenida, se pase como datos (ya que la información original son formulas) a la hoja de calculo llamada base con las variables que ahí se describen, adjunto ejemplo de lo como debe quedar la información.

de antemano agradezco de su tiempo y apoyo

Share this post


Link to post
Share on other sites

Esta macro traspasa los datos de la hoja activa a la hoja BASE:

Sub CopiarEnBASE()
Application.ScreenUpdating = False
With ActiveSheet
   x = Sheets("BASE").Range("A" & Rows.Count).End(xlUp).Row + 1
   For FILA = 10 To 52 Step 3
      If .Range("B" & FILA) <> "" Then
         Sheets("BASE").Range("A" & x) = WorksheetFunction.Max(Sheets("BASE").Columns("A")) + 1
         Sheets("BASE").Range("B" & x) = CDate(.Range("D7"))
         Sheets("BASE").Range("C" & x) = .Range("C6")
         Sheets("BASE").Range("D" & x) = .Range("J4")
         Sheets("BASE").Range("E" & x) = .Range("K7")
         Sheets("BASE").Range("F" & x) = .Range("D8")
         Sheets("BASE").Range("G" & x) = .Range("B" & FILA)
         Sheets("BASE").Range("H" & x) = .Range("C" & FILA)
         Sheets("BASE").Range("I" & x) = .Range("D" & FILA)
         Sheets("BASE").Range("J" & x) = .Range("E" & FILA)
         x = x + 1
      End If
   Next
   For FILA = 10 To 52 Step 3
      If .Range("H" & FILA) <> "" Then
         Sheets("BASE").Range("A" & x) = WorksheetFunction.Max(Sheets("BASE").Columns("A")) + 1
         Sheets("BASE").Range("B" & x) = CDate(.Range("D7"))
         Sheets("BASE").Range("C" & x) = .Range("C6")
         Sheets("BASE").Range("D" & x) = .Range("J4")
         Sheets("BASE").Range("E" & x) = .Range("K7")
         Sheets("BASE").Range("F" & x) = .Range("D8")
         Sheets("BASE").Range("G" & x) = .Range("H" & FILA)
         Sheets("BASE").Range("H" & x) = .Range("I" & FILA)
         Sheets("BASE").Range("I" & x) = .Range("J" & FILA)
         Sheets("BASE").Range("J" & x) = .Range("K" & FILA)
         x = x + 1
      End If
   Next
   Sheets("BASE").Select
End With
End Sub

 

Share this post


Link to post
Share on other sites

Libro1-EJEMPLO--8.xlsm

Hola Antoni, muchas gracias por tu valioso apoyo, quisiera que la macro se ejecutara desde la hoja base y copie los datos de la hoja VALE 1 y VALE 2 en la hoja BASE, observo que solo copia un solo Lote, por ejemplo en la celda D11 de la hoja de calculo, coloque un lote más y no lo copia.

 

Agradezco mucho tu apoyo Antoni, prácticamente son solo esos los puntos y quedará lista la macro.

Share this post


Link to post
Share on other sites
Sub CopiarEnBASE()
Application.ScreenUpdating = False
For Each hoja In Sheets(Array("VALE 1", "VALE 2"))
   With hoja
      x = Sheets("BASE").Range("A" & Rows.Count).End(xlUp).Row + 1
      For fila = 10 To 52 Step 3
         If .Range("B" & fila) <> "" Then
            For y = 0 To 2
               If .Range("D" & fila + y) <> "" Then
                  Sheets("BASE").Range("A" & x) = WorksheetFunction.Max(Sheets("BASE").Columns("A")) + 1
                  Sheets("BASE").Range("B" & x) = CDate(.Range("D7"))
                  Sheets("BASE").Range("C" & x) = .Range("C6")
                  Sheets("BASE").Range("D" & x) = .Range("J4")
                  Sheets("BASE").Range("E" & x) = .Range("K7")
                  Sheets("BASE").Range("F" & x) = .Range("D8")
                  Sheets("BASE").Range("G" & x) = .Range("B" & fila)
                  Sheets("BASE").Range("H" & x) = .Range("C" & fila)
                  Sheets("BASE").Range("I" & x) = .Range("D" & fila + y)
                  Sheets("BASE").Range("J" & x) = .Range("E" & fila + y)
                  x = x + 1
               End If
            Next
         End If
      Next
      For fila = 10 To 52 Step 3
         If .Range("H" & fila) <> "" Then
            For y = 0 To 2
               If .Range("J" & fila + y) <> "" Then
                  Sheets("BASE").Range("A" & x) = WorksheetFunction.Max(Sheets("BASE").Columns("A")) + 1
                  Sheets("BASE").Range("B" & x) = CDate(.Range("D7"))
                  Sheets("BASE").Range("C" & x) = .Range("C6")
                  Sheets("BASE").Range("D" & x) = .Range("J4")
                  Sheets("BASE").Range("E" & x) = .Range("K7")
                  Sheets("BASE").Range("F" & x) = .Range("D8")
                  Sheets("BASE").Range("G" & x) = .Range("H" & fila)
                  Sheets("BASE").Range("H" & x) = .Range("I" & fila)
                  Sheets("BASE").Range("I" & x) = .Range("J" & fila + y)
                  Sheets("BASE").Range("J" & x) = .Range("K" & fila + y)
                  x = x + 1
               End If
            Next
         End If
      Next
   End With
Next
End Sub

 

Share this post


Link to post
Share on other sites

Antoni, "¡¡¡¡¡sos un Crack!!!!!!", muchas gracias a tus conocimientos y vocación de solidaridad, la solución es la que necesitaba, el tema está más que solucionado.

 

Muchas Muchas gracias Antoni

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.
Sign in to follow this  

×
×
  • Create New...

Important Information

Privacy Policy