If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
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 |
#2
|
|||
|
|||
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 |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Combining MDB files | Frank J. Reda | General Discussion | 1 | August 26th, 2004 08:13 PM |
Delete Macros Macro | Steven | General Discussion | 1 | July 28th, 2004 01:55 AM |
Clear the "Recent Files" list in the hyperlink window | Mike | Powerpoint | 15 | July 22nd, 2004 02:51 AM |
combining a query and a macro | lynn atkinson | Running & Setting Up Queries | 1 | July 15th, 2004 11:31 AM |