Macro Help- combining "CS" files

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

First, I think you should comment the "on error goto exit_line" line.

Then you'll see which line is really causing the trouble.

I bet you'll find that it's this one:

lngMaxRow = shtTemp.Cells.SpecialCells(xlCellTypeLastCell).Row

..specialcells doesn't play nicely with protected worksheets.

Is there some other way to determine the last row?

Maybe a column that's always filled in:

with shtTemp
lngMaxRow = .cells(.rows.count,"A").end(xlup).row
end with

I stole this from Debra Dalgleish's site:
http://www.contextures.com/xlfaqApp.html#Unused

Maybe you can include a version of it into your code. (I left the myLastCol in
just in case you ever needed it.)

Option Explicit
Sub testme()

Dim myLastRow As Long
Dim myLastCol As Long
Dim DummyRng As Range

myLastRow = 0
myLastCol = 0
With ActiveSheet
Set DummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
End With

MsgBox myLastRow & vbLf & myLastCol

End Sub




Judyt wrote:
>
> 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

--

Dave Peterson