reachbds,
Give the following a try. It will prompt you to select a folder, and then remove blank rows from each worksheet in each .xls file in that folder.
Sub tgr()
Dim strFldrPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
On Error Resume Next: strFldrPath = .SelectedItems(1)
End With
If strFldrPath = vbNullString Then Exit Sub
Dim CurrentFile As String: CurrentFile = Dir(strFldrPath & "\" & "*.xls*")
Dim wb As Workbook
Dim ws As Worksheet
Dim cIndex As Long
Application.ScreenUpdating = False
While CurrentFile <> vbNullString
Set wb = Workbooks.Open(strFldrPath & "\" & CurrentFile)
For Each ws In wb.Sheets
With ws.UsedRange
For cIndex = 1 To .Columns.Count
.AutoFilter cIndex, "="
Next cIndex
.Offset(1).EntireRow.Delete xlShiftUp
.AutoFilter
End With
Next ws
wb.Close True
CurrentFile = Dir
Wend
Application.ScreenUpdating = True
End Sub
Hope that helps,
~tigeravatar
Bookmarks