应用程序定义或对象定义错误。从工作表复制到另一个工作簿中的工作表

时间:2015-04-09 19:06:04

标签: excel vba runtime-error

我有一段代码可以检查文件是否打开,并根据该条件复制并粘贴单元格信息。当程序运行时,我收到一条错误消息,上面写着"应用程序定义或对象定义错误"。引发错误的行被注释。

' check if the file is open

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

shttocopy.Range("A11:J11").Resize(xlDown).Copy       'error is on this line 

destSheet.Range("A4:J4").Cells(xlDown).PasteSpecial


Application.DisplayAlerts = False

wkbDest.Save
wkbDest.Close

Application.DisplayAlerts = True

我做错了什么?

1 个答案:

答案 0 :(得分:0)

这是一个让你入门的代码:

Sub test()
Dim lastRow As Integer, lastCol As Integer, startRow As Integer
Dim ws As Worksheet, newWS As Worksheet

Set ws = ActiveSheet

startRow = 11 'starting in row 11 - you can change this.

'Create and name the new worksheet, which you will paste into.
Sheets.Add After:=Sheets(Sheets.Count) 'add to end of workbook
ActiveSheet.Name = "New Sheet"
Set newWS = Sheets("New Sheet")

' Starting in cell A11, what's the last row in that group of cells?
With ws
    If IsEmpty(.Cells(startRow + 1, 1)) Then ' this will check to see if there's only one row of data.
            lastRow = startRow ' If A12 is blank, you don't want last row to be 66000, so just set 11 as the last row
        Else
            lastRow = .Cells(startRow, 1).End(xlDown).Row
    End If
    ' Starting in cell A11, how many columns to the right are there?
    lastCol = .Cells(startRow, 1).End(xlToRight).Column

    ' Now, let's copy your range - NOTE: You don't need copy, so I commented this out.  But this would copy it if you didn't.
    ' .Range(.Cells(startRow, 1), .Cells(lastRow, lastCol)).Copy
End With

' Paste the data into the new sheet
Dim newLastRow As Integer 'what row is the starting row for your info?
newLastRow = newWS.Cells(66000, 1).End(xlUp).Row + 1 'starting in A66000, what's the next row with info? Add one because you want to start on the next blank row

newWS.Range(newWS.Cells(startRow, 1), newWS.Cells(lastRow, lastCol)) = ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, lastCol)).Value
Application.CutCopyMode = False

End Sub

您不一定需要复制/粘贴 - 您可以将一个范围的值设置为等于另一个范围的值。

不知道为什么要在新工作表上粘贴到第4行,我只是将您的数据复制到与原始工作表相同的范围内。如果你让我知道为什么第4行(那是“下一个”打开的行,从第1行开始?),我可以做一些调整。

我希望代码有意义,我试着评论一下。当然,您需要将这些内容添加到您的变量中,但它应该让您前进。

至于resize(),我很确定你必须声明列和行的大小调整。如果您没有调整宽度(列)或高度(行)的大小,只需将“1”作为调整大小编号。