Esse erro, provavelmente foi devido a falta dos códigos de revezamento, já que o preenchimento das planilhas adicionadas baseia-se nessa informação, em não existindo gera erro.
Caso não deseje que a rotina exclua as planilhas (se preferir faze-lo manualmente, quando necessário), exclua ou "comente" inserindo um apóstrofo " ' " (sem as aspas) no inicio da linha, o seguinte trecho do codigo:
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
msg = MsgBox("deseja excluir as planilhas", vbYesNo, "Atenção")
If msg = vbYes Then
For Each plan In Sheets
If plan.Name <> "Base" Then plan.Delete
Next
End If
End If
Application.DisplayAlerts = True
Abaixo segue o codigo alterado verificando tambem se em c4 há dado, e excluindo o botão "executar" das demais planilhas; copie e cole sobre o existente.
Dim uD As Integer
Sub AbrePlans()
Dim x As Integer, c As Integer
Dim msg As VbMsgBoxResult
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
msg = MsgBox("deseja excluir as planilhas", vbYesNo, "Atenção")
If msg = vbYes Then
For Each plan In Sheets
If plan.Name <> "Base" Then plan.Delete
Next
End If
End If
Application.DisplayAlerts = True
If Sheets("Base").Range("B1") = "" Or Sheets("Base").Range("C4") = "" Then
MsgBox "Informe a data em B1 e horarios nos demais campos"
Exit Sub
Else
uD = Day(Application.WorksheetFunction.EoMonth(Sheets("Base").Range("B1"), 0))
End If
For x = 1 To uD
c = Sheets.Count
Sheets("Base").Copy After:=Sheets(c)
Sheets(c + 1).Name = Format(x, "00")
ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
Selection.Delete
Next
Folgas
Application.ScreenUpdating = True
MsgBox "Concluido"
Sheets("Base").Range("A15,A4:A9,B1,C4:C9").ClearContents
End Sub
Sub Folgas()
Dim a As String, b As String, c As String, d As String, e As String, f As String
Dim g As String, h As String, i As String, j As String, k As String, l As String
Dim Cel0 As String, Cel1 As String, Cel2 As String
Dim x As Integer
Dim nPlancel As Range
Dim nFolga()
nFolga = Array("C2", "C3", "FOLGA")
Set nPlancel = Worksheets("01").Cells
a = nPlancel(4, 1).Value
b = nPlancel(5, 1).Value
c = nPlancel(6, 1).Value
d = nPlancel(7, 1).Value
e = nPlancel(8, 1).Value
f = nPlancel(9, 1).Value
For x = 1 To uD Step 2
Cel1 = Format(x, "00"): Cel2 = Format(x + 1, "00"): Cel0 = Format(x - 1, "00")
If Cel0 = "00" Then
m = ""
Else
m = Application.Match(Sheets(Cel0).Cells(4, 3).Value, nFolga, 0) - 1
End If
If x = 1 Then
g = nPlancel(4, 3).Value
h = nPlancel(5, 3).Value
i = nPlancel(6, 3).Value
j = nPlancel(7, 3).Value
k = nPlancel(8, 3).Value
l = nPlancel(9, 3).Value
Sheets(Cel1).Cells(1, 2) = VBA.CDate("01/" & Month(Sheets("Base").Range("B1")) & "/" & Year(Sheets("Base").Range("B1")))
Sheets(Cel1).Cells(1, 6) = VBA.Format(Sheets(Cel1).Cells(1, 2), "DDDD")
Sheets(Cel2).Cells(1, 2) = Sheets(Cel1).Cells(1, 2) + 1
Sheets(Cel2).Cells(1, 6) = VBA.Format(Sheets(Cel2).Cells(1, 2), "DDDD")
Else
Sheets(Cel1).Cells(1, 2) = Sheets(Cel0).Cells(1, 2) + 1
Sheets(Cel1).Cells(1, 6) = VBA.Format(Sheets(Cel1).Cells(1, 2), "DDDD")
If Cel2 <= 30 Then
Sheets(Cel2).Cells(1, 2) = Sheets(Cel1).Cells(1, 2) + 1
Sheets(Cel2).Cells(1, 6) = VBA.Format(Sheets(Cel2).Cells(1, 2), "DDDD")
End If
Select Case m
Case 0
g = nFolga(1)
h = nFolga(1)
i = nFolga(2)
j = nFolga(2)
k = nFolga(0)
l = nFolga(0)
Case 1
g = nFolga(2)
h = nFolga(2)
i = nFolga(0)
j = nFolga(0)
k = nFolga(1)
l = nFolga(1)
Case 2
g = nFolga(0)
h = nFolga(0)
i = nFolga(1)
j = nFolga(1)
k = nFolga(2)
l = nFolga(2)
End Select
End If
Sheets(Cel1).Cells(4, 1) = a
Sheets(Cel1).Cells(5, 1) = b
Sheets(Cel1).Cells(6, 1) = c
Sheets(Cel1).Cells(7, 1) = d
Sheets(Cel1).Cells(8, 1) = e
Sheets(Cel1).Cells(9, 1) = f
Sheets(Cel1).Cells(4, 3) = g
Sheets(Cel1).Cells(5, 3) = h
Sheets(Cel1).Cells(6, 3) = i
Sheets(Cel1).Cells(7, 3) = j
Sheets(Cel1).Cells(8, 3) = k
Sheets(Cel1).Cells(9, 3) = l
'Verifica se já está na planilha
If Cel2 <= uD Then
Sheets(Cel2).Cells(9, 3) = l
Sheets(Cel2).Cells(4, 1) = a
Sheets(Cel2).Cells(5, 1) = b
Sheets(Cel2).Cells(6, 1) = c
Sheets(Cel2).Cells(7, 1) = d
Sheets(Cel2).Cells(8, 1) = e
Sheets(Cel2).Cells(9, 1) = f
Sheets(Cel2).Cells(4, 3) = g
Sheets(Cel2).Cells(5, 3) = h
Sheets(Cel2).Cells(6, 3) = i
Sheets(Cel2).Cells(7, 3) = j
Sheets(Cel2).Cells(8, 3) = k
End If
Next
End Sub
Postado : 31/08/2013 9:01 am