Sub Copia_de_Backup()
Dim Valor_D As Long, Mes As Byte, Turno As String, _
Valor_G As Long, Product As Long, Fila_Out As Long, _
Valor_I As Long, SW_Error As Boolean
Dim Fila As Long, Datos As Boolean
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.CutCopyMode = False
Sheets("plantilla repaso").Select
' ---&--- Cuenta cuantas filas tiene que copiar
Datos = False
For Fila = 8 To 33
If Cells(Fila, "A") <> "" Then Datos = True
Next
' ---&--- Si esta vacio no hay que copiar
If Not Datos Then Exit Sub
' ---&--- Realiza la suma de datos
For Fila = 8 To 33
' ---&--- Lee los datos
Valor_D = Cells(Fila, "D")
Valor_G = Cells(Fila, "G")
Valor_I = Cells(Fila, "I")
Mes = Month(Cells(Fila, "A")) * 3
Turno = Cells(Fila, "K")
Product = Cells(Fila, "L")
If Not Turno = Empty Then
' ---&--- Cambia a la hoja de TURNO, Controla que el turno este mal escrito
On Error GoTo Turno_Desconocido
SW_Error = True: Sheets("TURNO " & Turno).Select SW_Error = False
On Error GoTo 0
' ---&--- Busca la fila del producto
Fila_Out = 7
While Left(Cells(Fila_Out, "B"), 7) <> "TOTALES" And _
Cells(Fila_Out, "A") <> Product And Fila_Out < 2 ^ 9
Fila_Out = Fila_Out + 1
Wend
' ---&--- Si encontro el producto guarda los datos
If Cells(Fila_Out, "A") = Product Then
If Valor_D <> 0 Then Cells(Fila_Out, Mes + 0) = Cells(Fila_Out, Mes + 0) + Valor_D
If Valor_G <> 0 Then Cells(Fila_Out, Mes + 1) = Cells(Fila_Out, Mes + 1) + Valor_G
If Valor_I <> 0 Then Cells(Fila_Out, Mes + 2) = Cells(Fila_Out, Mes + 2) + Valor_I
Else
MsgBox "No he localizado el productor: " & Product & " en el turno " & Turno
End If
End If
Turno_Desconocido:
' ---&--- Si no encontro la hoja del producto
If SW_Error Then
MsgBox "En la fila " & Fila & " el turno: " & Turno & _
" no lo puedo identificar.", vbCritical + vbOKOnly, "ERROR TURNO"
End If
Sheets("plantilla repaso").Select Next
' <---------------------------------- Quitar para que realice la copia ( PARA PRUEBAS )
' ---&--- Copia el rango de filas
Range("A8:L33").Select Selection.Copy
Sheets("COPIAS").Select
' ---&--- Busca la primera celda vacia donde copiar
Fila = 8
While Cells(Fila, "L") <> "": Fila = Fila + 26: Wend
' ---&--- Copia y se posiciona
ActiveSheet.Unprotect "sisi"
Range("A" & Fila).Select: ActiveSheet.Paste Range("A" & Fila).Select ActiveSheet.Protect "sisi"
Application.CutCopyMode = False
Sheets("plantilla repaso").Select
' ---&--- Limpia el rango copiado
Range("A8:L33").Select: Selection.ClearContents Range("A8").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
