Как я могу скопировать и вставить лист Excel в новую книгу, не меняя ссылки? - PullRequest
0 голосов
/ 05 июня 2018

Я пытаюсь скопировать и вставить лист из одной книги Excel в другую.Рабочий лист интегрируется в локальные модели этого рабочего листа.Поэтому мне нужно, чтобы ссылки на ячейки из скопированного листа не изменились в абсолютном смысле.

Например, ячейка с "='Sheet1'C1" должна оставаться "='Sheet1'C1", а не "='[OriginalWorkbook]Sheet1'C1"

Прямо сейчас я получаю непреднамеренные последствия при использовании,

Sub TransferSheet(wka As Workbook, wkb As Workbook, WorksheetName As String)
    Dim ws1 As Worksheet
    wka.Activate
    Set ws1 = wka.Worksheets(WorksheetName)
    wkb.Activate
    ws1.Copy after:=wkb.Worksheets(Worksheets.Count)
End Sub

Ответы [ 2 ]

0 голосов
/ 05 июня 2018

Я смог найти страницу на Super User, которая дала мне представление о том, как решить эту проблему в VBA.Поскольку это общая проблема, люди использовали множество решений, таких как копирование и вставка содержимого в текстовый редактор, а затем обратно на новый лист.Другим решением является использование функции поиска и замены.

Адаптируя это к VBA, проблему можно решить, выполнив поиск и замену на листах после их копирования.

Sub TransferSheet(wka As Workbook, wkb As Workbook, WorksheetName As String)
   Dim ws1 As Worksheet
   wka.Activate
   Set ws1 = wka.Worksheets(WorksheetName)
   wkb.Activate
   ws1.Copy after:=wkb.Worksheets(Worksheets.Count)
   wkb.ChangeLink "wka.xls", "wkb.xls", xlExcelLinks

   Dim sht As Worksheet
   Dim fnd As Variant
   Dim rplc As Variant

   fnd = "'[" & wka.Name & "]Summary'!"
   rplc = ""

   For Each sht In ActiveWorkbook.Worksheets
      sht.Cells.Replace what:=fnd, Replacement:=rplc, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
   Next sht
End Sub
0 голосов
/ 05 июня 2018

Я думаю, что это должно работать:

Sub TransferSheet(wka As Workbook, wkb As Workbook, WorksheetName As String)
    Dim ws1 As Worksheet
    wka.Activate
    Set ws1 = wka.Worksheets(WorksheetName)
    wkb.Activate
    ws1.Copy after:=wkb.Worksheets(Worksheets.Count)
    wkb.ChangeLink "wka.xls", "wkb.xls", xlExcelLinks
End Sub

Редактировать: Это решение работает для изменения ссылок на кнопки макросов.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...