Então atualmente o critério de numeração está sendo a ordem que os arquivos estão na pasta (vou disponibilizar o código no post), porém como quero eliminar essa etapa de colocar tudo em uma pasta só penso em utilizar o nome do arquivo como critério pois o nome dos arquivos são ex. TT 0001, TT 0002, TT 0003 e assim por diante.
O modelo do arquivo a ser numerado são todos "iguais" alguns tem 4 sheets outros 5, as vezes a celula que deve conter a numeração muda de local de um sheet para o outro por isso fiz um "IF" para testar.
Sub numeratudo2()
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim pgtotal As Integer
Dim folha As Integer
Dim data As String
Dim relatorio As String
I = 1
folha = 1
pgtotal = 0
' ENTRADA DE DADOS
MyFolder = InputBox("Digite o local dos arquivos a serem numerados", "Local dos arquivos", "C:\")
data = InputBox("Digite a data para ser inserida nos arquivos, caso não tenha deixe em branco", "Data relatório", "27/04/2017")
relatorio = InputBox("Digite o numero do relatorio", "Digite abaixo o numero do relatório para ser inserido as folhas", "0000010")
'FIM ENTRADA DE DADOS
MyFile = Dir(MyFolder & "\*.xlsx")
'CONTAGEM DAS PAGINAS
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
S = Sheets().Count
pgtotal = pgtotal + S
Windows(MyFile).Close (False)
MyFile = Dir
Loop
'!!SEGUNDA ETAPA
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
Z = Sheets.Count
Do While I <= Z
Sheets(I).Select
ActiveWindow.Zoom = 100
If Range("I1") = "FOLHA" Then
Range("I2").Select
ActiveCell.NumberFormat = "@"
Selection.Font.Bold = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.FormulaR1C1 = folha & "/" & pgtotal
Else
Range("N1").Select
ActiveCell.NumberFormat = "@"
Selection.Font.Bold = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.FormulaR1C1 = folha & "/" & pgtotal
End If
Sheets(I).Name = "Folha " & folha & "-" & pgtotal
folha = folha + 1
I = I + 1
Loop
Sheets(1).Select
Range("C6").FormulaR1C1 = relatorio
Range("c6").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("I4").FormulaR1C1 = data
Windows(MyFile).Close (True)
I = 1
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox ("Arquivos numerados")
End Sub