Excel - Problemas con vba al cambiar de año

Hola!!

Verán acabo de entrar en una empresa y tiene una base de datos donde salen unas gráficas que se actualizan cada semana con los nuevos registros. Esta base copia los datos de un excel donde se guardan.

Pues bien, al cambiar el año ha empezado a dar problemas y a no actualizar las gráficas. De hecho, ni siquiera se copian los valores.

Al ejecutar la macro siempre sale el error 1004 en la misma línea

Workbooks.Open (RUTA & "\EVOLUCION INDISPONIBLE 2014 V4.XLSX")
Sheets("DATOS").Select
Range("B3").Select
SEMANADATOS = Right(ActiveCell.Value, 2)
SEMANA = Format(SEMANA, "00")
Do While SEMANADATOS <> SEMANA

ActiveCell.Offset(1, 0).Select Esta es la línea que da fallo

SEMANADATOS = Right(ActiveCell.Value, 2)
Loop

Si ejecuto la macro con una fecha del año pasado rula bien pero a partir del 2 de Enero...

No se mucho de esto así que agradezco toda la ayuda que podáis prestarme.

Gracias y un saludo!

Buenas tardes
Has un paso a paso del código con un punto de quiebre o pon mas código y pon el error completo
cuando coloques el resto del codigo te podre dar una mejor asesoria por que no se de donde obtienes la variable SEMANA
por lo pronto te recomiendo que revises el archivo de la ruta en especial la hoja datos en la ceda B3
y tiene que cambiar ese while

Gracias por contestar!!

He intentado ejecutar paso a paso pero es un lío tremendo y al final no me he enterado de nada!

El error completo que me da es este:

Se ha producido el error '1004' en tiempo de ejecución:

Error producido por la aplicación o el objeto

Y el código completo es el siguiente (es un poco largo)

Sub MACRO()
Application.ScreenUpdating = False
RUTA = ThisWorkbook.Path



UserForm1.Show
Sheets("TOTAL").Select
inicio = Range("N1")
final = Range("N2")

MATRIZCONTADORES(1, 1) = "TOTAL"
MATRIZCONTADORES(2, 1) = "TALLER B"
MATRIZCONTADORES(3, 1) = "TALLER D"
MATRIZCONTADORES(4, 1) = "PIÑONES"
MATRIZCONTADORES(5, 1) = "ARBOL"
MATRIZCONTADORES(6, 1) = "CUBO DESPLAZABLE CORONA"
MATRIZCONTADORES(7, 1) = "TTH"
MATRIZCONTADORES(8, 1) = "FOSFATADO"

Application.Run ("COGEDATOS")


Sheets("HOJADATOS").Select
Range("A1").Select
If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter 'elimina los filtros anteriores

Range("F2").Select
Selection.End(xlDown).Select
e = ActiveCell.Row



Range("BA1").Formula = "=SUBTOTAL(3,A2:A1300)"
MATRIZCONTADORES(1, 2) = Range("BA1").Value

For I = 2 To 8
Sheets("HOJADATOS").Select

If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter

Cells.Select

Selection.AutoFilter Field:=3, Criteria1:=MATRIZCONTADORES(I, 1)



Range("BA1").Formula = "=SUBTOTAL(3,A1:A5730)"
MATRIZCONTADORES(I, 2) = Range("BA1").Value
If MATRIZCONTADORES(I, 2) = 0 Then
Sheets(MATRIZCONTADORES(1, 1)).Range("D" & I + 4) = 0
Sheets(MATRIZCONTADORES(1, 1)).Range("E" & I + 4) = 0
Sheets(MATRIZCONTADORES(1, 1)).Range("E" & I + 4).Style = "Currency"
Sheets(MATRIZCONTADORES(1, 1)).Range("F" & I + 4) = 0
Sheets(MATRIZCONTADORES(1, 1)).Range("G" & I + 4) = 0
Sheets(MATRIZCONTADORES(1, 1)).Range("G" & I + 4).Style = "Currency"

Else
Range("BA2").Formula = "=SUBTOTAL(9,R1:R1730)"
MATRIZCONTADORES(I, 7) = Range("BA2").Value


Range("A2:W" & e).Select
Selection.Copy
Sheets(MATRIZCONTADORES(I, 1)).Select
Range("A2").Select
ActiveSheet.Paste


'calulos de evolucion


Sheets(MATRIZCONTADORES(I, 1)).Select
Columns("M:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim fila, filaev
Dim nregistro

fila = 2
Do While fila - 1 <> e
nregistro = Range("A" & fila)

Sheets("HOJA EVOLUCION").Select

filaev = 2
Do While Range("K" & filaev).Value <> nregistro
filaev = filaev + 1
Loop

Range("L" & filaev & ":P" & filaev).Copy
Sheets(MATRIZCONTADORES(I, 1)).Select
Range("M" & fila).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
fila = fila + 1

Loop

Range("M1") = "Añadida"
Range("N1") = "Liberada"
Range("O1") = "Retocado/controlado"
Range("P1") = "Derogada"
Range("Q1") = "Chatarra"

Columns("W:X").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("W2").Select
Range("W1").Formula = "Precio Total Abierto"
Range("W2").Formula = "=AA2*K2"
Selection.AutoFill Destination:=Range("W2:W" & e), Type:=xlFillDefault

Range("X2").Select
Range("X1").Formula = "Precio Total Cerrado"
Range("X2").Formula = "=(Q2+P2+O2+N2)*AA2"
Selection.AutoFill Destination:=Range("X2:X" & e), Type:=xlFillDefault

Range("Y:Y").Select
Range("Y1").Formula = "Precio Total Inicial"

Range("AE1") = "FECHA CERRADO"

Range("AE2").Select
Range("AE2").Formula = "=IF(RC[-13]=""Cerrado"",VLOOKUP(RC[-30],'HOJA EVOLUCION'!R2C20:R21500C21,2,FALSE),"""")"
Selection.AutoFill Destination:=Range("AE2:AE" & e), Type:=xlFillDefault

Range("AE2:AI2").Select
Selection.AutoFill Destination:=Range("AE2:AI" & e), Type:=xlFillDefault

Columns("AE:AH").Select
Selection.EntireColumn.Hidden = True

Range("AI2").Select
Do While ActiveCell.Row <> e
If ActiveCell > final Or ActiveCell < inicio Then
If ActiveCell <> "" Then
filaborrada = ActiveCell.Row
Rows(filaborrada & ":" & filaborrada).Select
Selection.Delete Shift:=xlUp
Range("AI" & filaborrada).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Range("S1:V1").Select
Selection.Copy
Range("R1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("V1") = "Plazo"

Cells.Select
Selection.ColumnWidth = 99
Selection.RowHeight = 17.25
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.EntireColumn.AutoFit


If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter
Cells.Select
Selection.AutoFilter Field:=18, Criteria1:="Abierto"
Range("BA1").Formula = "=SUBTOTAL(3,A1:A1730)"
MATRIZCONTADORES(I, 3) = Range("BA1").Value - 1
Cells.Select
If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter ''
Range("BA2").Formula = "=SUM(W1:W50730)"
MATRIZCONTADORES(I, 5) = Range("BA2").Value

If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter
Cells.Select
If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter
Selection.AutoFilter Field:=18, Criteria1:="Cerrado"
Range("BA1").Formula = "=SUBTOTAL(3,A1:A1730)"
MATRIZCONTADORES(I, 4) = Range("BA1").Value - 1
Cells.Select
Range("BA2").Formula = "=SUM(X1:X50730)"
MATRIZCONTADORES(I, 6) = Range("BA2").Value

If ActiveSheet.FilterMode = True Then Range("a1").AutoFilter




Sheets(MATRIZCONTADORES(1, 1)).Range("D" & I + 4) = MATRIZCONTADORES(I, 3)
Sheets(MATRIZCONTADORES(1, 1)).Range("E" & I + 4) = MATRIZCONTADORES(I, 5)
Sheets(MATRIZCONTADORES(1, 1)).Range("E" & I + 4).Style = "Currency"
Sheets(MATRIZCONTADORES(1, 1)).Range("F" & I + 4) = MATRIZCONTADORES(I, 4)
Sheets(MATRIZCONTADORES(1, 1)).Range("G" & I + 4) = MATRIZCONTADORES(I, 6)
Sheets(MATRIZCONTADORES(1, 1)).Range("G" & I + 4).Style = "Currency"

End If




Next


Sheets(MATRIZCONTADORES(1, 1)).Select

Range("C47:I52").Select
Selection.Style = "Currency"
Range("C57:I62").Select
Selection.Style = "Currency"

Range("D47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TALLER B'!R1C20:R6500C20,RC1,'TALLER B'!R1C23:R6500C23)"
Range("E47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TALLER D'!R1C20:R6500C20,RC1,'TALLER D'!R1C23:R6500C23)"
Range("F47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('PIÑONES'!R1C20:R6500C20,RC1,'PIÑONES'!R1C23:R6500C23)"
Range("G47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('ARBOL'!R1C20:R6500C20,RC1,'ARBOL'!R1C23:R6500C23)"
Range("H47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('CUBO DESPLAZABLE CORONA'!R1C20:R6500C20,RC1,'CUBO DESPLAZABLE CORONA'!R1C23:R6500C23)"
Range("I47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TTH'!R1C20:R6500C20,RC1,'TTH'!R1C23:R6500C23)"
Range("J47").Select
ActiveCell.FormulaR1C1 = "=SUMIF('FOSFATADO'!R1C20:R6500C20,RC1,'FOSFATADO'!R1C23:R6500C23)"

Range("D47:J47").Select
Selection.AutoFill Destination:=Range("D47:J52"), Type:=xlFillValues
Range("D47:J52").Select

Range("D57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TALLER B'!R1C20:R6500C20,RC1,'TALLER B'!R1C24:R6500C24)"
Range("E57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TALLER D'!R1C20:R6500C20,RC1,'TALLER D'!R1C24:R6500C24)"
Range("F57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('PIÑONES'!R1C20:R6500C20,RC1,'PIÑONES'!R1C24:R6500C24)"
Range("G57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('ARBOL'!R1C20:R6500C20,RC1,'ARBOL'!R1C24:R6500C24)"
Range("H57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('CUBO DESPLAZABLE CORONA'!R1C20:R6500C20,RC1,'CUBO DESPLAZABLE CORONA'!R1C24:R6500C24)"
Range("I57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('TTH'!R1C20:R6500C20,RC1,'TTH'!R1C24:R6500C24)"
Range("J57").Select
ActiveCell.FormulaR1C1 = "=SUMIF('FOSFATADO'!R1C20:R6500C20,RC1,'FOSFATADO'!R1C24:R6500C24)"

Range("D57:J57").Select
Selection.AutoFill Destination:=Range("D57:J62"), Type:=xlFillValues
Range("D57:J62").Select

Range("F5:F12").Select
Selection.NumberFormat = "General"
fecha = Format(Date, "dd.mm.yy")
hora = Format(Now, "hh.mm")

Sheets("HOJA EVOLUCION").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("HOJADATOS").Select
ActiveWindow.SelectedSheets.Visible = False

'ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Indisponible " & fecha & " " & hora & ".xlsm"
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Indisponible " & fecha & " " & hora & ".xls"

Sheets("TOTAL").Select
SEMANA = Range("O2")

Range("D6:G12").Select
Selection.Copy

Workbooks.Open (RUTA & "\EVOLUCION INDISPONIBLE 2014 V4.XLSX")
'Workbooks.Open (RUTA & "\EVOLUCION INDISPONIBLE 2014 V4.XLS")


Sheets("DATOS").Select
Range("B3").Select
SEMANADATOS = Right(ActiveCell.Value, 2)
SEMANA = Format(SEMANA, "00")
Do While SEMANADATOS <> SEMANA
ActiveCell.Offset(1, 0).Select
SEMANADATOS = Right(ActiveCell.Value, 2)
Loop

ActiveCell.Offset(0, 3).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("GRAFICOS").Select


Windows("EVOLUCION INDISPONIBLE 2014 V4.xlsx").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close

ThisWorkbook.Save
Application.ScreenUpdating = True

End Sub

Gracias de nuevo!!

Revisa el archivo que tienes en la ruta
RUTA & "\EVOLUCION INDISPONIBLE 2014 V4.XLSX
mira bien este nombre tiene un 2014 depronto no cambiaria a 2015
y revisa la hoja datos que este bien el error esta alli

veo que no indicas como obtienes el dato de la variable "semana" ,sugiero que utilices el comando "explicit " al inicio de tu macro para que te muestre cada vez que variables necesitas preveer a la rutina

saludos

JPP

Hola de nuevo!!

Muchas gracias por contestarme aunque la verdad, sigo sin saber qué pasa con el código.
Es como si al entrar en el excel EVOLUCION INDISPONIBLE 2014 V4.XLSX no fuera capaz de leer las celdas y claro, al no recorrer la tabla, no puede copiar los datos.

La variable "semana" coge el dato de unas de las hojas de excel aplicándole una función.

Como creo que no me explico bien, os subo los archivos para ver si podéis descubrir lo que falla.

Os vuelvo a agradecer toda la ayuda posible!!!

• Datos.rar(338,5 KB)

Falta el archivo de base de datos para hacer la prueba

Cierto!!!

Aquí está.

El botón que rula esa macro es Informe Semanal (como el programa). No hace falta elegir ningún taller.

• BBDD-INDISPONIBLE.rar(1,7 MB)

Mirando sus archivos por encima descubrí algo
tu tienes en el archivo desde la B3 así
Semana 1
Semana 2
..........
y en el ciclo while dices
Do While SEMANADATOS <> SEMANA
y en la variable semana lo traes "01" osea la semana 1 y en la variable semanadatos tienes " 1" y "01" nunca va a ser igual a " 1"
entonces te sale el error en ActiveCell.Offset(1, 0).Select, por que el se va ir recorriendo todas las filas hasta que encuente el "01" osea va a llegar a la ultima fila de excel y no va a saber hacia donde seguir y por eso te sale el error.
esa es la razón por la que te "funcionaba el año pasado" ya que era la semana 20, 30, 52 con dos dijitos osea si haces la prueba con fechas despues de la semana 10 de este año te funcionara


SOLUCIÓN
cambia el while por este otro

Do While SEMANADATOS <> SEMANA
ActiveCell.Offset(1, 0).Select
SEMANADATOS = Right(ActiveCell.Value, 2)

SEMANADATOS = Format(SEMANADATOS, "00") 'CAMBIA EL FORMATO " 1" POR EL "01" PARA QUE TENGAN EL 'MISMO FORMATO

Loop

ojala te sirva para mas asesoría me cuentas

Muchas gracias!!!

Ya no me da el error!!!!

Lo malo es que las gráficas siguen sin actualizarse...

¿Qué puedo hacer? Es que llevo un par de semanas con esto y creo que ya he saturado y no soy capaz de verle una solución, aunque sea fácil de solucionar.