Consulta Macro creación de hojas con nombres según lista y que copie y pegue según criterios

Estimados estoy antes la necesidad de Crear una Macro donde por criterios de nombre y fecha se cree una hoja por ejemplo AMBA_(Fecha Variable según listado), y se peguen también los datos que coincidan con el Campo Envió y Fecha por separados, ya que lo único variable son los números de fechas.

Para que se entienda... Tengo estos campos...

En la base a veces el tipo de Envió (B) viene AMBA y las fechas (G) dos fechas diferentes... 15 y 16 de febrero.. Entonmces deberia crear una hoja AMBA_15_02_17 y otra hoja AMBA_16_02_17 y que me copie y pegue los criterios que coinciden...

Tengo esta macro para la creación de las mismas y que copie y pegue los encabezados de la hoja "Final"

Sub insertar_Hojas()
' Inserta Hojas con Nombre para el copiado

Worksheets.Add(After:=Worksheets("Final")).Name = "AMBA"
Worksheets.Add(After:=Worksheets("AMBA")).Name = "Interior_N"
Worksheets.Add(After:=Worksheets("Interior_N")).Name = "Interior_N1"
Sheets("Final").Select
Range("A1:G1").Select
Selection.Copy
Sheets("AMBA").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Interior_N").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Interior_N1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Final").Select
Range("A1").Select
End Sub

Y Esta otra donde copio y pego pero no sabría como diferenciar el filtro fecha y que hacer que se creen dos hojas diferentes segun fecha-...

Sub CopiadoAMBA()
Dim Reserva As String
Dim Tipo_de_Envio As String
Dim NroEnvio As Integer
Dim nombre As String
Dim Apellido As String
Dim Email As String
Dim Fecha_Envio As Date
Dim ultimaFila As Long
Dim ultimaFilaAuxiliar As Long
Dim cont As Long
Dim palabraBusqueda As String
palabraBusqueda = Sheets("Final").Cells(2, 10)
palabraBusqueda = "*" & palabraBusqueda & "*"
ultimaFila = Sheets("Final").Range("B" & Rows.Count).End(xlUp).Row
If ultimaFila < 2 Then
Exit Sub
End If
For cont = 2 To ultimaFila
If Sheets("Final").Cells(cont, 2) Like palabraBusqueda Then
Tipo_de_Envio = Sheets("Final").Cells(cont, 2)
Nro_Envio = Sheets("Final").Cells(cont, 3)
nombre = Sheets("Final").Cells(cont, 4)
Apellido = Sheets("Final").Cells(cont, 5)
Email = Sheets("Final").Cells(cont, 6)
Fecha_Envio = Sheets("Final").Cells(cont, 7)
ultimaFilaAuxiliar = Sheets("AMBA").Range("B" & Rows.Count).End(xlUp).Row
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 2) = Tipo_de_Envio
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 3) = Nro_Envio
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 4) = nombre
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 5) = Apellido
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 6) = Email
Sheets("AMBA").Cells(ultimaFilaAuxiliar + 1, 7) = Fecha_Envio
End If
Next cont
ultimaFilaAuxiliar = Sheets("AMBA").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("AMBA").Range("B2:G" & ultimaFilaAuxiliar).Font
.Name = "Arial"
.Size = 9
End With

Respuesta
1

H o la: Justamente en tu imagen no aparece el ejemplo "AMBA", lo que aparece es un texto más largo: "Interior N (entregas andreani ER)"

Por lo que veo en tu macro, quieres crear la hoja "Interior N", ¿pero en la celda dice otra cosa?

Para hacerlo de forma automática, tendrías que modificar la celda o bien, si el texto de la celda empieza con la palabra "Interior", ¿qué la macro cree la hoja y le ponga "Interior N"?

Otra cosa que no entiendo en tu macro, buscas una palabra que tienes en la columna "I", pero tampoco viene la columna "I" en tu imagen, entonces ya no entendí, se van a copiar los registros que coincidan con la fecha o con lo que tienen en la columna "I"

Podrías aclararlo.

Buenos días! gracias por tu respuesta y pido disculpas por no haber sido claro, para que se entienda mejor adjunto la imagen completa:

En la base que recibo hay pedidos donde el Campo de la columna "B", vienen con pedidos de "AMBA", "Int_N_Andreani", " Int_N_Cruz_del_Sur" y " Int_N1_Andreani", como se ve en el ejemplo. 

La macro que realice yo fue que tome los campos de la columna "I" para que realizar una nueva hoja y que copie y pegue de acuerdo si es "AMBA", "Int_N_Andreani", " Int_N_Cruz_del_Sur" o "Int_N1_Andreani".

El problema que se me presenta ahora es que se le agrega la condición Fecha, o sea ahora debería crear por ejemplo una Hoja AMBA_15-02-2017 y copiar y pegar en esa hoja todos los criterios que coincida con tipo de envío y fecha, y otra Hoja AMBA_14-02-2017 que coincida con los mismos criterios, lo mismo para el resto de tipo de envíos...

es por eso que la que hice yo tomaba los campos de la columna i pero ya no estaría sirviendo eso... Muchas gracias por la ayuda en el tema y perdón pero mi visual es muy básico :)

No te preocupes por tu macro, con explicar bien lo que necesitas apoyándote de ejemplos es suficiente.

Te anexo la macro para crear las hojas, supongo lo siguiente, la hoja que tiene los datos se llama "Final", la fila que tiene los encabezados es la fila 1, si es así, entonces prueba con la siguiente:

Sub Crear_Hojas()
'Por.Dante Amor
    Set h1 = Sheets("Final")
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        hoja = h1.Cells(i, "B") & "_" & Format(h1.Cells(i, "G"), "dd_mm_yyyy")
        existe = False
        For Each h In Sheets
            ahoja = h.Name
            If LCase(h.Name) = LCase(hoja) Then
                existe = True
                Set h2 = h
                Exit For
            End If
        Next
        If existe Then
            u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
            h1.Rows(i).Copy h2.Rows(u)
        Else
            Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
            h2.Name = hoja
            h1.Rows(1).Copy h2.Rows(1)
            h1.Rows(i).Copy h2.Rows(2)
        End If
    Next
    MsgBox "Fin"
End Sub

Nota: Este nombre que tienes "Int_N_Cruz_del_Sur" mas los caracteres de la fecha, da un total de 29 caracteres, si pones un nombre de más de 30 caracteres la maro no va a funcionar.


'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas