PDA

View Full Version : Run-time Error 1004



Auxie
10-18-2017, 07:35 AM
2016 user - macros have been working fine for the last couple months, newb coder.

So I've macros, while basic, have been working fine until today. I've included a snippet of my code below -


Dim wb1 As Workbook, wb2 As WorkbookSet wb1 = ThisWorkbook


'Clear sheets
Worksheets("RFIs").Select
Rows("2:" & Rows.Count).ClearContents
Worksheets("TQs").Select
Rows("2:" & Rows.Count).ClearContents
Worksheets("EWNs").Select
Rows("2:" & Rows.Count).ClearContents
Worksheets("CEs").Select
Rows("2:" & Rows.Count).ClearContents
Worksheets("PMIs").Select
Rows("2:" & Rows.Count).ClearContents


'Framework

Set wb2 = Workbooks.Open("Path", UpdateLinks:=0)

wb2.Worksheets("TQ Register").Range("A9:L100").Copy
wb1.Worksheets("TQs").Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wb2.Worksheets("RFI Register").Range("A9:K100").Copy
wb1.Worksheets("RFIs").Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wb2.Worksheets("EWN").Range("A9:L100").Copy
wb1.Worksheets("EWNs").Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wb2.Worksheets("CE").Range("A10:N100").Copy
wb1.Worksheets("CEs").Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

wb2.Worksheets("PMI").Range("A8:M100").Copy
wb1.Worksheets("PMIs").Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

wb2.Close SaveChange = True
Application.DisplayAlerts = False

The code below the clear sheets is then duplicated a number of times for different spreadsheets but follows the same copy/paste code.

anyways, the debugger is flagging this line of code the first line of code but when I remove them it then jumps to this line


wb1.Worksheets("TQs").Activate

Pathways and sheet names are correct however they aren't running. However when i debug further it will actually pull the data as normal.

A little more information - the macros themselves are saved in a module and I have a Userform (containing a description and a button to start them), the buttons code is simply


Module1.pulldata

I assume I'm going to have to completely rewrite this?

Kenneth Hobs
10-18-2017, 12:19 PM
There is seldom a need for Select, Selection, Activate, and such. I recommend going beyond the macro recorder. http://www.tushar-mehta.com/excel/vba/beyond_the_macro_recorder/index.htm

As you can see in my example, I show how to check if workbook is open and sheet exists. I also show how to skip Activate.

Sub cp()
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet

Set wb1 = Workbooks("Book1")
'Set wb2 = Workbooks("Book2")
'Set wb2 = Workbooks("ActivateNotNeeded.xlsm")
Set wb2 = ThisWorkbook
Set ws1 = wb1.Worksheets(1)
Set ws2 = wb2.Worksheets(1)

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

MsgBox "Exists?: " & ws1.Parent.Name & "!" & ws1.Name, , _
WorkSheetExists(ws1.Name, ws1.Parent.Name)
MsgBox "Exists?: " & ws2.Parent.Name & "!" & ws2.Name, , _
WorkSheetExists(ws2.Name, ws2.Parent.Name)

'e.g.'s
'Clear sheet(s)
If WorkSheetExists("RFIs", wb2.Name) Then _
wb2.Worksheets("RFIs").Rows("2:" & _
wb2.Worksheets("RFIs").Rows.Count).ClearContents

With ws1.Range("A1:A10")
.Formula = "=row() & "" "" & column()"
.Copy
.Value = .Value
ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub


'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already. e.g. ken.xlsm, not x:\ken.xlsm.
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function




Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function