Run macro on all files in a specific folder

  • Thread starter Thread starter AndreasHermle
  • Start date Start date
A

AndreasHermle

Dear Experts:

below code deletes all the rows that have the string 'NZ' in Column E in all the sheets of the active workbook.

Could somebody please help me to expand this macro ...

.... so that it runs on all the excel-files in a folder (folder picker). There are only excel files in that specific folder.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas



Sub Delete_NZ_From_AllSheets_In_Workbook()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lastrow As Long, r As Long

For Each Worksheet in ActiveWorkbook.Worksheets
ShtName = Worksheet.Name
Sheets(ShtName).Select
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 1 Step -1
If UCase(Cells(r,5).Value) = "NZ" Then Rows(r).Delete
Next r
Next Worksheet

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Hi Andreas,

Am Thu, 12 Dec 2013 23:01:47 -0800 (PST) schrieb AndreasHermle:
... so that it runs on all the excel-files in a folder (folder picker). There are only excel files in that specific folder.
Click to expand...

try:

Sub Delete_NZ_From_AllSheets()
Dim objFSO As Object
Dim objOrdner As Object
Dim objDatei As Object
Dim lastrow As Long, r As Long
Dim wsh As Worksheet

'Modify for your Path
Const myPath = "F:\Test\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(myPath)

On Error Resume Next
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

For Each objDatei In objOrdner.Files
Workbooks.Open myPath & objDatei.Name
For Each wsh In ActiveWorkbook.Worksheets
With wsh
lastrow = .UsedRange.Rows.Count
For r = lastrow To 1 Step -1
If UCase(.Cells(r, 5)) = "NZ" Then .Rows(r).Delete
Next r
End With
Next wsh
ActiveWorkbook.Close savechanges:=True
Next

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Regards
Claus B.
 
Hi Claus,

Great! Good Job!:)
Works like a charm, thank you very much for your professional support.
I really appreciate it.
Regards, Andreas
 
Hi Andreas,

Am Sat, 14 Dec 2013 09:45:05 -0800 (PST) schrieb AndreasHermle:
Works like a charm, thank you very much for your professional support.
Click to expand...

always glad to help.
Thank you for the feedback


Regards
Claus B.
 
Back
Top