Macro para copiar e ingresar formatos de una celda a otras
Hola! Dante
Tengo un problema con un código que me diste este realiza bien su trabajo pero tengo un problema que no me había percatado, en algunas celdas pone las fechas y estas fechas son las mimas no se cual seria el problema o hay que modificar la macro.
Y la macro que me diste es la siguiente .
Sub PonerFechas()
'Por. Dante
On Error Resume Next
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
fec1 = Split(n, ".")
fec2 = DateSerial(fec1(2), fec1(1), fec1(0))
h1.Cells(6, u) = n
h1.Cells(5, u) = UCase(Format(fec2, "dddd"))
End If
End If
Next
h1.Range(h1.Cells(60, ci), h1.Cells(151, ci)).Copy _
h1.Range(h1.Cells(60, ci), h1.Cells(151, u))
End SubEl problema se presenta en las filas 128:129 , 137:138, y la 146:147 estas llevan nombres de la semana con fecha. Gracias por la respuesta que me puedas dar
1 respuesta
Respuesta de Dante Amor
1
Borra los datos y prueba con esta macro
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
fec1 = Split(n, ".")
fec2 = DateSerial(fec1(2), fec1(1), fec1(0))
h1.Cells(6, u) = n
h1.Cells(5, u) = Format(fec2, "dddd")
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
h1.Range(h1.Cells(60, ci), h1.Cells(151, ci)).Copy
h1.Range(h1.Cells(60, ci), h1.Cells(151, u)).PasteSpecial Paste:=xlPasteFormats
MsgBox "fin"
End Sub
