从另一个工作簿复制工作表，包括图表

Question

我想从另一个工作簿中复制一个作品sheet并替换ThisWorkbook中的一个sheet。但是，我不想删除 ThisWorkbook 中的 sheet，因为我在其他作品 sheet 上有公式引用了这个特定作品 sheet。通过先删除工作sheet，我的公式将以#REF.

结尾

因此我写了下面的代码，但是这段代码没有复制图表：

Sub Copy_from_another_workbook

    Dim wb As Workbook
    Dim sWorksheet As String

    ThisWorkbook.Worksheets("Destinationsheet").Cells.ClearContents
    Set wb = Workbooks.Open(ThisWorkbook.Worksheets("input").Range("sFileSource"), ReadOnly:=True, UpdateLinks:=False)
    sWorksheet = ThisWorkbook.Worksheets("input").Range("sWorksheetSource")

    wb.Worksheets(sWorksheet).Cells.Copy
    ThisWorkbook.Worksheets("Destinationsheet").Activate
    ThisWorkbook.Worksheets("Destinationsheet").Range("A1").Select
    Selection.PasteSpecial xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
    Selection.PasteSpecial xlPasteColumnWidths
    Selection.PasteSpecial xlPasteFormats
    Selection.UnMerge

    wb.Close

End Sub

这段代码没有错误，但没有复制图表。我尚未找到一种用pastepecial复制图表的方法，我从中理解，选择范围时不能使用糊状方法。

如何粘贴包括图表在内的数据并且仍然能够使用 pastespecial 因为我不希望公式也被粘贴？

或者有其他方法可以达到要求的结果吗？

Answer 1

将代码更改为：

Sub Copy_from_another_workbook

    Dim wb As Workbook
    Dim sWorksheet As String
    Dim rCell As Range

    Set wb = Workbooks.Open(ThisWorkbook.Worksheets("input").Range("sFileSource"), ReadOnly:=True, UpdateLinks:=False)
    sWorksheet = ThisWorkbook.Worksheets("input").Range("sWorksheetSource")
    wb.Worksheets(sWorksheet).Copy before:=ThisWorkbook.Worksheets("Destinationsheet")

    ThisWorkbook.Activate

    For Each rCell In ThisWorkbook.Worksheets("SheetWithFormulas").Range("b1:c30")
        rCell.Formula = Replace(rCell.Formula, "Destinationsheet", "'" & sWorksheet & "'")
    Next

    ThisWorkbook.Worksheets(sWorksheet).Cells.Select
    Selection.Copy
    Selection.PasteSpecial xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
    wb.Close

    ThisWorkbook.Worksheets("Destinationsheet").Delete
    ThisWorkbook.Worksheets(sWorksheet).Name = "Destinationsheet"

End sub

Answer 2

您不需要激活或 select 任何东西。这是您自己的代码的一个版本，已注释、修改为不这样做并进行了部分重新排列。

Sub Copy_from_another_workbook()

    Dim WbTgt As Workbook               ' Target
    Dim WbSrc As Workbook               ' Source
    Dim Wname As String                 ' intermediate use for both Wb and Ws:
                                        ' better let a "Sheet" be a sheet
'    Dim rCell As Range

    Application.ScreenUpdating = False
    Set WbTgt = ThisWorkbook
    With WbTgt.Worksheets("input")
        ' extracting the name separately makes testing the code easier
        Wname = .Range("sFileSource")
        Set WbSrc = Workbooks.Open(Wname, ReadOnly:=True, UpdateLinks:=False)
        Wname = .Range("sWorksheetSource")
    End With

    With WbSrc
        .Worksheets(Wname).Copy Before:=WbTgt.Worksheets("Destinationsheet")
        .Close
    End With

'    ThisWorkbook.Activate
'    For Each rCell In ThisWorkbook.Worksheets("SheetWithFormulas").Range("b1:c30")
'        rCell.Formula = Replace(rCell.Formula, "Destinationsheet", "'" & Wname & "'")
'    Next
    ' Consider a less specific range instead:-
    ' With WbTgt.Worksheets("SheetWithFormulas").UsedRange
    With WbTgt.Worksheets("SheetWithFormulas").Range("B1:C30")
        .Replace What:="Destinationsheet", Replacement:="'" & Wname & "'", _
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    End With

    With WbTgt.Worksheets(Wname).Cells
        .Copy
        .PasteSpecial xlPasteValues     ', Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        WbTgt.Worksheets("Destinationsheet").Delete
        .Name = "Destinationsheet"
    End With
    Application.ScreenUpdating = True
End Sub

我无法测试运行代码。

从另一个工作簿复制工作表，包括图表

Copy worksheet from another workbook including charts

excel

vba

copy-paste