VBA macro worked at one time - now giving 1004 error "application defined or object defined error"

Viewed 39

I had a macro that was working until recently. The macro essentially goes through each .xlsx file in a folder and copies a range of data from each file into a separate "summary" workbook. The code is below. The debugger shows me the line highlighted with asterisks below where the application/object error is, but I can't seem to figure it out. Any help is appreciated as I'm new to VBA and coding.

Sub SummariseDataCCETR13Test()
Dim SummWb As Workbook
Dim SceWb As Workbook
'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Show
 On Error Resume Next
 myFolderName = .SelectedItems(1)
 Err.Clear
 On Error GoTo 0
End With
If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"
'Settings
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Set SummWb = ActiveWorkbook
'Get source files and append to output file
myFileNum = 1
mySceFileName = Dir(myFolderName & "*.*")
myUsedCols = SummWb.Sheets("TestData").UsedRange.Columns
Do While mySceFileName <> "" 'Stop once all files found
 Application.StatusBar = "Processing: " & mySceFileName
 Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
 Dim emptyColumn As Long
 emptyColumn = SummWb.Sheets("TestData").Cells(1, 1).End(xlToRight).Column
 If emptyColumn > 1 Then
        emptyColumn = emptyColumn + 1
    End If
 **SceWb.Sheets("Summary").Range("A14:b150").Copy SummWb.Sheets("TestData").Cells(1, emptyColumn)**
 SceWb.Close (False) 'Close Workbook
 myFileNum = myFileNum + 1
 mySceFileName = Dir
Loop
'Settings and save output file
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
SummWb.Activate
' SummWb.Save 'Uncomment this line if you want to save at the end of the process.
Application.ScreenUpdating = True
End Sub
1 Answers

Here:

Dim emptyColumn As Long
emptyColumn = SummWb.Sheets("TestData").Cells(1, 1).End(xlToRight).Column
If emptyColumn > 1 Then
    emptyColumn = emptyColumn + 1
End If

you run the risk of the End(xlToRight) taking you all the way over to the last column. If you then add 1 to that you're off the sheet.

This is safer as long as there's no other content to the right of your top row:

emptyColumn = SummWb.Sheets("TestData").Cells(1, Columns.Count).End(xlToLeft).Column
Related