I am using the following code to copy the data from a file to temporary file but I keep getting the error object required - can any one help me with where I am going wrong please.
Sub CopyandPasteData()
Dim wsCopy As Worksheet
Dim wsDest As Workbook
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Report")
JobName = "Service items report for " & Sheets("Analysis").Range("A1").Value
TempFileName = Environ$("temp") & "\" & JobName & ".xlsx"
Set wsDest = TempFileName.Sheets("Sheet1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:AI" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
Application.CutCopyMode = False
End Sub
I am using the following code to copy the data from a file to temporary file but I keep getting the error object required - can any one help me with where I am going wrong please.
Sub CopyandPasteData()
Dim wsCopy As Worksheet
Dim wsDest As Workbook
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Report")
JobName = "Service items report for " & Sheets("Analysis").Range("A1").Value
TempFileName = Environ$("temp") & "\" & JobName & ".xlsx"
Set wsDest = TempFileName.Sheets("Sheet1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:AI" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
Application.CutCopyMode = False
End Sub
Share
Improve this question
asked yesterday
JannetteJannette
254 bronze badges
2
|
1 Answer
Reset to default 0Backup Table Data in Another Workbook
Sub BackupData()
' Reference the source copy range.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim scws As Worksheet: Set scws = swb.Sheets("Report")
Dim scrg As Range, sRowsCount As Long
With scws.Range("A1")
sRowsCount = scws.Cells(scws.Rows.Count, "A").End(xlUp).Row - .Row + 1
If sRowsCount < 1 Then
MsgBox "No data in source workbook!", vbExclamation
Exit Sub
End If
Set scrg = .Resize(sRowsCount).EntireRow.Columns("A:AI")
End With
' Retrieve the job name from the source lookup sheet
' and build the destination file name and path.
Dim slws As Worksheet: Set slws = swb.Sheets("Analysis")
Dim JobName As String:
JobName = "Service items report for " & slws.Range("A1").Value
Dim dFileName As String: dFileName = JobName & ".xlsx"
Dim dFilePath As String: dFilePath = Environ("TEMP") & "\" & dFileName
' When the workbook is open, use the file name.
' When it's closed, you must use the full file path.
' Reference the first destination cell.
Dim dwb As Workbook, WasWorkbookOpen As Boolean
On Error Resume Next ' prevent error if not open
Set dwb = Workbooks(dFileName)
On Error GoTo 0
If dwb Is Nothing Then ' was closed; open it (if it exists)
If Len(Dir(dFilePath)) = 0 Then
MsgBox "The file """ & dFilePath & """ doesn't exist!", _
vbExclamation
Exit Sub
End If
Set dwb = Workbooks.Open(dFilePath)
Else ' was open
If StrComp(dFilePath, dwb.FullName, vbTextCompare) <> 0 Then ' wrong
MsgBox "A workbook with the same name but in a different " _
& "location is already open!", vbExclamation
Exit Sub
Else ' correct
If Not dwb.Saved Then dwb.Save
End If
WasWorkbookOpen = True
End If
Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1")
Dim dcell As Range: Set dcell = dws _
.Range("A2", dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1))
' Copy, save and close.
' Either...
srg.Copy Destination:=dcell
' ... or only values
'dcell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
' Decide on your own whether you want to save and close.
' If WasWorkbookOpen Then
' dwb.Save
' Else
' dwb.Close SaveChanges:=True
' End If
' Inform of succes.
MsgBox "Data backed up.", vbInformation
End Sub
Dim wsDest As Workbook
toDim wsDest As Worksheet
and useSet wsDest = Workbooks.Open(TempFilename).Sheets("Sheet1")
. You could also addIf Dir(TempFilename) = "" Then MsgBox TempFilename & " does not exist"
before that line. – CDP1802 Commented yesterday