最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

excel - How to copy data from a workbook sheet to a temp file sheet - Stack Overflow

programmeradmin3浏览0评论

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
  • tempFileName is a string, not a workbook. Do you need to open a workbook using that path? – Tim Williams Commented yesterday
  • Change Dim wsDest As Workbook to Dim wsDest As Worksheet and use Set wsDest = Workbooks.Open(TempFilename).Sheets("Sheet1"). You could also add If Dir(TempFilename) = "" Then MsgBox TempFilename & " does not exist" before that line. – CDP1802 Commented yesterday
Add a comment  | 

1 Answer 1

Reset to default 0

Backup 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
发布评论

评论列表(0)

  1. 暂无评论