Below is the macro I have to go to a certain file and combine all
spreadsheets. I did not write this macro myself. I just received it and
modified it to work for my situation. When this maco is run it gets to the
first file and says I cannot change a read only file and says I must
unprotect the worksheet. This sheet is not protected but I really only want
to copy the info on it anyway. Is there a way to modify this macro to copy
the information. I could save all of the "CS" files as new files but that
would defeat the purpose of automating this job
Any help is greatly appreciated.
Sub CollectAll()
On Error GoTo Exit_Line
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim wbkTempBook As Workbook
Dim shtPasteSheet As Worksheet, shtTemp As Worksheet
Dim lngMaxRow As Long, lngCopyRows As Long, lngPasteRow As Long,
lngIgnoreRows As Long

lngPasteRow = 2 'Row to start copying to
lngIgnoreRows = 1 'Number of Rows to ignore

Set shtPasteSheet = ThisWorkbook.Sheets(1)

sFolderPath = "G:\Accounting\Invoicing\SHIPPING CHARGES\FebruaryClipper"

sTempName = Dir(sFolderPath & "\*cs")
Do While sTempName < ""
Set wbkTempBook = Workbooks.Open(sFolderPath & "\" & sTempName, True,
True)
Set shtTemp = wbkTempBook.Sheets(1)
lngMaxRow = shtTemp.Cells.SpecialCells(xlCellTypeLastCell).Row
lngCopyRows = lngMaxRow - lngIgnoreRows
If lngMaxRow lngIgnoreRows Then
shtTemp.Range("A" & lngIgnoreRows + 1 & ":V" & lngMaxRow).COPY _
shtPasteSheet.Range("A" & lngPasteRow & ":V" & lngPasteRow +
lngCopyRows - 1)
lngPasteRow = lngPasteRow + lngCopyRows
End If
wbkTempBook.Close (False)
sTempName = Dir
Loop

Exit_Line:
Application.EnableEvents = True
Application.ScreenUpdating = True
If Err.Number < 0 Then MsgBox Err.Description
End Sub