Question

编辑：我更新了一些代码，现在我也收到了一条现在的错误消息。错误如下所示。

我在这个网站上找到了一段代码，并将工作表复制到我想要的另一个工作簿，但是我想做一些微调。我需要源工作表从单元格“A11” - “J11”复制单元格中的所有信息，直到行中的信息结束。

复制的信息需要在单元格“A4” - “J4”中向下发布，直到没有更多信息要粘贴为止。

当复制工作表时，需要将其命名为某个名称（假设它需要命名为“Customer Information”），但是，目标工作簿中将有一个同名的当前工作表。有没有办法复制它而不将（1）添加到名称的末尾，因为已经有一个带有该名称的选项卡。

这是我目前的代码

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 file is open
Ret = Isworkbookopen("\\showdog\service\\Service_job_PO\Customer Information - Query.xls")
If Ret = False Then
' 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 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").End(xlDown).Copy

此处抛出错误：“object不支持此属性或方法”

wkbDest.Sheets(destSheet.Name).Range("A4:J4").End(xlDown).Paste

我不确定为什么。我以为我的一切都是正确的，但我显然不是

Application.DisplayAlerts = False

wkbDest.Save
wkbDest.Close

Application.DisplayAlerts = True

'close file
Else
'Just make it active
 'Workbooks("C:\stack\file2.xlsx").Activate
 Set wkbDest = Workbooks("Service Jobs.xlsm")
 Set destSheet = wkbDest.Sheets("Customer Information")
'perform copy
Set shttocopy = wkbSource.Sheets("Report")
shttocopy.Range("A11:J11").End(xlDown).Copy
wkbDest.Sheets(destSheet.Name).Range("A4:J4").End(xlDown).Paste

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

我不确定如何完成上述任务。任何帮助将不胜感激！

Answer 1

此代码可以更改。

shttocopy.Range("A11:J11").End(xlDown).Copy
wkbDest.Sheets(destSheet.Name).Range("A4:J4").End(xlDown).Paste

到

shttocopy.Range("A11:J11").Copy destsheet.range("A4")

您不需要将destSheet.name放在Sheets（）中虽然宏录制器将创建单独的复制/粘贴指令，但应该像上面那样重写。

End（xlDown）通常用于定位下一个可用于复制的行，不应该以这种方式使用。

如果要一次复制一行，请使用End（xlUP）查找下一个可用行：

lRow = DestSheet.Range("A65536").end(xlUP).row + 1
shttocopy.Range("A1").Copy destsheet.range("A" & lrow)

如果您需要识别要复制的范围的右下角地址，请使用以下内容：

 dim aRange as range

 set aRange = shttocopy.range(Range("A1").address, Cells(shttocopy.usedrange.rows.count, shttocopy.usedrange.columns.count).address)

  Shttocopy.arange.copy ...

一行上的复制和另一行的粘贴方法经常会抛出错误，建议更换它。如上所述。

Answer 2

要复制整个范围表单shttocopy（使用@Rgo所说的并假设shttocopy范围内没有空白单元格）到destsheet中现有范围的底部+ 1行（再次假定列“A”中没有空格）。

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

复制工作表excel VBA微调。从某些细胞复制，粘贴在某些细胞和细胞中。工作表命名，

2 个答案: