Copy worksheet from another workbook including charts

问题

I want to copy a worksheet from another workbook and replace a sheet in ThisWorkbook. However, I do not want to delete the sheet in ThisWorkbook, since I have formulas on other worksheets refering to this certain worksheet. By deleting the worksheet first, my formulas will end up as #REF.

Therefore I have written the following code but this code does not copy charts:

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

This code trows no errors but does not copy charts. I have not yet found a way to copy charts with pastespecial, and I understood from this post that you can not use the Paste method when ranges are selected.

How to paste the data including charts and still being able to use pastespecial since I do not want the formulas to be pasted as well?

Or is there another way to achieve the required outcome?

回答1:

You don't need to activate or select anything. Here is a version of your own code commented, amended not to do that and partially rearranged.

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

I couldn't test run the code.

回答2:

Changed the code to:

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

来源：https://stackoverflow.com/questions/48019513/copy-worksheet-from-another-workbook-including-charts