Macro para Jalar datos con sus formatos de una columna a otra
Para Dante
Agradeciendo por la gran ayuda que nos brindas en el foro, como puedo realizar para que me jale los datos con sus formatos de la otras columnas según nombre de fechas que tienen las hojas, lo que quiero lograr con este tema es que pueda ser todo automático sin necesidad de jalar o arrastrar los datos, formulas etc. Manualmente de las otras columnas, te comento que tengo una macro que me diste y esta macro actualiza o jala los datos de las demás hojas conjuntamente quisiera que al ejecutar esta macro también jale o arrastre los otros datos que están en las otras columnas por ejemplo.
El circulo azul ya actualizo los datos con una macro que me diste y del circulo Rojo falta jalar los datos de la columna KL. Bueno espero que se entienda el ejemplo.
1 respuesta
Hola! Dante
Gracias dante te envió el archivo para las correcciones. De los botones de "Actualiza Hectolitros" y "Actualiza m3" sus macros son las siguientes.
Sub Copia_Hectolitros() 'Actualiza Hectolitros
On Error Resume Next
Application.ScreenUpdating = False
Set h1 = Sheets("INGRESO DATOS")
For Each h In Sheets
If InStr(1, h.Name, ".") > 0 Then
celda7 = h.[L7]
celda11 = h.[L11]
Set b = h1.Rows(51).Find(h.Name)
If Not b Is Nothing Then
h1.Cells(52, b.Column) = h.[L7]
h1.Cells(53, b.Column) = h.[L11]
Else
u = h1.Cells(51, Columns.Count).End(xlToLeft).Column + 1
If u < 3 Then u = 3
h1.Cells(51, u) = h.Name
h1.Cells(52, u) = h.[L7]
h1.Cells(53, u) = h.[L11]
End If
End If
Next
MsgBox "Copia de datos terminado", vbInformation, ""
End Suby de Actualiza M3 es la siguiente.
Sub Copia_M3() 'Actualiza m3
'Por Dante
Application.ScreenUpdating = False
Set h1 = Sheets("INGRESO DATOS")
For Each h In Sheets
If InStr(1, h.Name, ".") > 0 Then
celda22 = h.[J22]
celda23 = h.[J23]
Celda24 = h.[J24]
celda25 = h.[J25]
celda26 = h.[J26]
Celda27 = h.[J27]
celda30 = h.[J30]
Set b = h1.Rows(56).Find(h.Name)
If Not b Is Nothing Then
h1.Cells(59, b.Column) = h.[J27]
h1.Cells(61, b.Column) = h.[J22]
h1.Cells(63, b.Column) = h.[J23]
h1.Cells(65, b.Column) = h.[J24]
h1.Cells(67, b.Column) = h.[J25]
h1.Cells(69, b.Column) = h.[J26]
h1.Cells(73, b.Column) = h.[J30]
Else
u = h1.Cells(56, Columns.Count).End(xlToLeft).Column + 1
If u < 3 Then u = 3
h1.Cells(56, u) = h.Name
'
fec1 = Split(h1.Cells(56, u), ".")
fec2 = DateSerial(fec1(2), fec1(1), fec1(0))
h1.Cells(57, u) = Format(fec2, "dddd")
'
h1.Cells(59, u) = h.[J27]
h1.Cells(61, u) = h.[J22]
h1.Cells(63, u) = h.[J23]
h1.Cells(65, u) = h.[J24]
h1.Cells(67, u) = h.[J25]
h1.Cells(69, u) = h.[J26]
h1.Cells(73, u) = h.[J30]
End If
End If
Next
MsgBox "Copia de datos terminado", vbInformation, ""
End Sub
Gracias por la respuesta que me puedas dar.
Te comento que estas macros cumplen otras funciones lo que faltaría seria actualizar las otras columnas con la misma cantidad de fechas que insertaron estas dos macros.
Te anexo la macro para jalar
Sub PonerFechas()
'Por.Dante Amor
Set h1 = Sheets("INGRESO DATOS")
ci = h1.Cells(60, Columns.Count).End(xlToLeft).Column
For Each h In Sheets
If InStr(1, h.Name, ".") > 0 Then
n = h.Name
Set b = Rows(6).Find(n)
If b Is Nothing Then
u = h1.Cells(6, Columns.Count).End(xlToLeft).Column + 1
h1.Cells(6, u) = n
End If
End If
Next
h1.Range(h1.Cells(60, ci), h1.Cells(151, ci)).Select
Selection.AutoFill Destination:=h1.Range(h1.Cells(60, ci), h1.Cells(151, u)), Type:=xlFillDefault
MsgBox "fin"
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Hola! Dante
Gracias esta muy bien, un detalle no se si se puede jalar con la macro que me diste con sus bornes respectivos si no es mucha molestia, y disculpa si soy muy exigente en la fila 5 esta no me jala los días de la semana.
Podrías valorar la respuesta y crear una nueva por cada petición.
¡Gracias! Dante
Realmente sorprendente la macros que me diste, te estaré asiendo llegar la nueva pregunta Muchísimas gracias saludos.
