The code below is untested. Make a new folder and put a copy of a few of
your workbooks to be cleaned up into it along with a workbook with this code
in it. Open the workbook with this code in it and run the
MassFileAndSheetCleanup macro. Examine the other workbooks after it
completes to make sure it worked properly. If it looks good, copy the rest
of the workbooks to be cleaned up into that same folder and run it again.
This way you have cleaned up copies and still have the originals if something
goes wrong. I've not altered your other code at all, I just call the
DeleteEmptyRows routine from within this code, although I show that code here
also. This obviously does nothing to consolodate workbooks - you already
have that other routine to do that with after getting things cleaned up.
Hope this helps.

Sub MassFileAndSheetCleanup()
'put the file containing this code
'in the same folder with all other .xls
'files to be cleaned up and then
'open this workbook and run this macro
Dim anyFile As String
Dim basePath As String
Dim anySheet As Worksheet
Dim anyWB As Workbook

basePath = Left(ThisWorkbook.FullName, _
InStrRev(ThisWorkbook.FullName, "\"))
anyFile = Dir$(basePath & "*.xls")
Do While anyFile < ""
If anyFile < ThisWorkbook.Name Then
Workbooks.Open basePath & anyFile
'the opened workbook becomes the active workbook
'now go through the sheets in that workbook
Application.ScreenUpdating = False
For Each anySheet In ActiveWorkbook.Worksheets
If anySheet.Visible = xlSheetVisible Then
' so your routine can work w/o change
anySheet.Select
DeleteEmptyRows ' call your routine
Application.ScreenUpdating = False
End If
Next
ActiveWorkbook.Close True ' close and save changes
'this workbook is again the active workbook
End If
'get next filename
anyFile = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Cleanup is complete."
End Sub

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub


"BenS" wrote:

I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.

I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.

I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub
************************************************** ************************************************** ************************************************** ******************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).O ffset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub