Fernando Spinelli

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

isso, preciso numerar paginas, porém cada pagina está em um arquivo.

Então o nome do arquivo não seria alterado, e sim uma determinada célula do arquivo. Pela função dos aquivos não e possível juntar tudo em um só. Vou dar um exemplo pra ver se fica mais claro, é como se fosse um livro onde cada pagina é um arquivo do excel. Como é um processo que ocorre varias vezes queria achar um jeito de não teque juntar todos arquivos em uma pasta. Fiz uma macro que numera as paginas porém tenho que juntar tudo em uma unica pasta ai utilizo a função "DIR" do VBA para abrir cada arquivo e fazer as alterações, gostaria de apenas eliminar essa etapa de juntar tudo em uma pasta.

Olá pessoal estou precisando de uma macro para numeras arquivos do excel, vou dar um exemplo, pois na realidade são 360 hahaha, tenho 10 pasta cada uma com um arquivo ".xlsx" dentro. Preciso que a macro abra o arquivo ".xlsx" da pasta 1 coloque numero 1 em uma determinada célula feche o arquivo, abra o arquivo ".xlsx" da pasta 02 escreva o numero 2 em uma determinada célula e feche, e assim por diante. O resultado final esperado é "Pagina 01/10" O resultado final esperado é "Pagina 02/10" Quem souber de algo que me ajude agradeço.