带语句的对象定义错误。复制工作表数据并粘贴到另一个工作簿

时间:2015-04-10 20:38:38

标签: excel excel-vba vba

我有一段代码复制从单元格A10开始的信息,直到第J列并遍历所有行,直到它用完数据。必须填充第一列,其余的都是命中和未命中。单元格中可能有数据,也可能没有。然后将复制的数据传输到另一个工作簿并粘贴到当前工作表上的信息中。

我需要找到一种方法来复制所有信息,无论数据是否在单元格中。

此外,在with shttocopy部分的当前状态下,我收到了一个"应用程序或对象定义的错误"信息。

只是为了澄清我需要每个单元格中包含A列数据的单元格从单元格A10开始,直到最后一行填充,并将所有内容从那里复制到列J,结束于列A中包含数据的同一行。然后将其粘贴到另一个工作簿的工作表中。

这是代码......我希望我有道理

Sub UpdateCustomerInformation()

Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String
Dim destSheet As Worksheet









' check if the source file is open
Ret = Isworkbookopen("\\showdog\service\\Service_job_PO\Customer Information - Query.xls")
If Ret = False Then
' if file is not open the open file
Set wkbSource = Workbooks.Open("\\showdog\service\\Service_job_PO\Customer Information - Query.xls")
Else
'Just make it active
 'Workbooks("C:\stack\file1.xlsx").Activate
 Set wkbSource = Workbooks("Customer Information - Query.xls")
 End If

' check if the destination file is open
Ret = Isworkbookopen("\\showdog\service\Service Jobs.xlsm")
If Ret = False Then
' if file is not open file
Set wkbDest = Workbooks.Open("\\showdog\service\Service Jobs.xlsm")
Set destSheet = wkbDest.Sheets("Customer Information")
'perform copy
Set shttocopy = wkbSource.Sheets("Report")

With shttocopy
    .Range(.Range("A10"), .Range("A10").End(xlDown).End(xlToRight)).Copy _
    destSheet.Range("A4").End(xlDown).Offset(1)
End With


Application.DisplayAlerts = False
'save and close file
wkbDest.Save
wkbDest.Close

Application.DisplayAlerts = True


Else
'destination file is open
'Just make it active
 Set wkbDest = Workbooks("Service Jobs.xlsm")
 Set destSheet = wkbDest.Sheets("Customer Information")
'perform copy
Set shttocopy = wkbSource.Sheets("Report")
With shttocopy
    .Range(.Range("A10"), .Range("A10").End(xlDown).End(xlToRight)).Copy _
    destSheet.Range("A4").End(xlDown).Offset(1)
End With





End If



End Sub

Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String

wbname = filename
On Error Resume Next

ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select
End Function

1 个答案:

答案 0 :(得分:1)

考虑:

With shttocopy
    .Range(.Range("A10"), .Range("A10").End(xlDown).End(xlToRight)).Copy _
    destSheet.Range("A4").End(xlDown).Offset(1)
End With

在范围结束时,您:

  • 从A10开始
  • 使用A列中的值
  • 下到最后一行
  • 使用值
  • 转到该行的最后一列

由于最后一行不太可能已满,因此您无法获得完整的一列。

我不喜欢这样的陈述,因为我发现它们令人困惑,很难做对。很难猜出哪个位给出错误。

使用类似:

RowLast = .Cells(Rows.Count,"A").End(XlUp).Row

找到最后一行。例如,如果没有第二行,这将避免问题。你知道列J是最后一列所以如何:

With shttocopy
  .Range("A10:J" & LastRow).Copy _
               destSheet.Cells(Rows.Count,"A").End(xlUp).Offset(1)
End With