复制工作表excel VBA微调。从特定单元格复制、粘贴到特定单元格和工作表命名，

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

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

复制的信息需要张贴在单元格A4-J4中，并沿着行向下，直到没有更多信息可粘贴为止

复制工作表时，需要将其命名为某个名称，比如说，需要将其命名为客户信息。但是，目标工作簿中会有一个同名的当前工作表。有没有办法复制它而不在名称末尾添加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

此处引发错误：对象不支持此属性或方法

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

---

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

此代码可以更改

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

到

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

EndxlDown通常用于定位下一个可供复制的行，不应以这种方式使用

如果要一次复制一行，请使用EndxlUP查找下一行：

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 ...

---

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

使用@Rgo所说的内容复制整个范围表单shttocopy，并假设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

---

如果要操作数据或属性（如目标工作表的名称），则需要将该工作表另一个工作表对象作为工作表。然后，您需要将其拆分为更具体的shttocopy.RangeA11:J11.Copy并将其粘贴到destSheet wkbDest.SheetsdestSheet.name.RangeA4:J4.paste，而不是执行shttocopy.Copy。您粘贴的代码中有很多硬定义的元素，因此如果您希望它更健壮，我可能建议更改其中一些。如果你需要更多的帮助，我可以提供一个更复杂的答案。我会试一试。我知道如何利用这些信息完成我的任务。我只是不知道如何开始。我会让你知道我的进步。谢谢我听从了你的建议，但是我现在犯了一个错误。我更新了代码，以便您可以看到我所做的一切。@RichardHorvath，对于Range对象只有一个特殊的方法。您可以编辑该行，使其如下所示：wkbDest.destSheet.RangeA4:J4.EndxlDown.PasteSpecial-注意，我还更改了图纸部分，您已经设置了图纸，您不需要再次执行此操作。请参阅，使用此选项时，我仍然会收到一个错误，显示为“应用程序定义”或“对象定义”错误。我不熟悉将.EndxlDown.EndxlroRight嵌入范围内…复制。如果您试图识别单元格地址的右下边缘，我建议您在复制命令之外进行识别，就像我上面写的那样。您还可以使用源工作表.UsedRange.columns.count获取最后一列编号，使用.UsedRange.Rows.count获取最后一行。这两个内嵌在Cellsrow中的列将返回地址。最后，在另一个范围内使用Range函数时，请尝试添加.address。@rgo End方法会返回一个范围，因此您可以再次将其作为一个范围进行操作，例如使用另一个End方法，这会再次返回一个范围对象，因此您可以复制或选择它，或者其他范围方法。没有为此抛出错误或任何东西，但是它表明什么也没有做。这只是一张空白纸，没有复制过任何东西

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