Running code on all files from a folder

[rfgattu]

Hello Guys, I would like to run this code on all files from a specific folder.

Someone could please help me?

Best Regards,

Rafael Fernandes


Code (from Tommy Miles of Houston, Texas):

Sub SplitWorkbook()
Dim ws As Worksheet
Dim DisplayStatusBar As Boolean
DisplayStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
Dim NewFileName As String
Application.StatusBar = ThisWorkbook.Sheets.Count & _
" Remaining Sheets"
If ThisWorkbook.Sheets.Count <> 1 Then
NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsm" _
'Macro-Enabled
' NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsx" _
'Not Macro-Enabled
ws.Copy
ActiveWorkbook.Sheets(1).Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
' ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Else
NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsm"
' NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
ws.Name = "Sheet1"
End If
Next
Application.DisplayAlerts = True
Application.StatusBar = False
Application.DisplayStatusBar = DisplayStatusBar
Application.ScreenUpdating = True
End Sub

 

[NdNoviceHlp]

Seems like your just copying sheets. Here's a general outline for looping all the files... it may need some tweaks. Adjust the folder path to suit. HTH. Dave

Private Sub test()
Dim FSO As Object, FolDir As Object, FileNm As Object, Cnt As Integer
On Error GoTo Erfix
Set FSO = CreateObject("scripting.filesystemobject")
Set FolDir = FSO.GetFolder(ThisWorkbook.Path & "\Datafiles") '***change to suit
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xlsm" Then
Cnt = Cnt + 1
Workbooks.Open FileName:=FileNm
Sheets("Sheet1").Copy After:=ThisWorkbook.Sheets(Cnt)
Application.DisplayAlerts = False
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
Exit Sub
Erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set FSO = Nothing
End Sub