Скопировать лист и получить итоговый объект листа?

Ответ 1

Dim sht 

With ActiveWorkbook
   .Sheets("Sheet1").Copy After:= .Sheets("Sheet2")
   Set sht = .Sheets(.Sheets("Sheet2").Index + 1)
End With

Ответ 2

Я верю, что я, наконец, прибил эту проблему - это тоже затирало меня! Было бы неплохо, если бы MS сделала Copy возвратом объекта листа, так же как и метод Add...

Дело в том, что индекс, который VBA выделяет недавно скопированный лист, на самом деле не определен... как отмечали другие, он очень сильно зависит от скрытых листов. На самом деле, я думаю, выражение Sheets (n) фактически интерпретируется как "n-й видимый лист". Поэтому, если вы не пишете цикл, проверяющий каждое видимое свойство листа, использование этого кода в кошме чревато опасностью, если только рабочая книга не защищена, поэтому пользователи не могут испортить видимое свойство листов. Слишком сложно...

Мое решение этой дилеммы:

• Сделать LAST-лист видимым (даже если временно)
• Скопировать ПОСЛЕ того листа. Он ДОЛЖЕН иметь индекс Sheets.Count
• Спрячьте предыдущий последний лист, если потребуется - он теперь будет иметь index Sheets.Count-1
• Переместите новый лист туда, где вы действительно хотите.

Здесь мой код - который теперь кажется пуленепробивным...

Dim sh as worksheet
Dim last_is_visible as boolean

With ActiveWorkbook
    last_is_visible = .Sheets(.Sheets.Count).Visible
    .Sheets(Sheets.Count).Visible = True
    .Sheets("Template").Copy After:=.Sheets(Sheets.Count)
    Set sh=.Sheets(Sheets.Count)
    if not last_is_visible then .Sheets(Sheets.Count-1).Visible = False 
    sh.Move After:=.Sheets("OtherSheet")
End With

В моем случае у меня было что-то вроде этого (H указывает на скрытый лист)

1... 2... 3 (H)... 4 (H)... 5 (H)... 6... 7... 8 (H)... 9 (H )

.Copy After: =. Листы (2) фактически создают новый лист перед следующим ВИДИМОЙ лист - т.е. Он стал новым индексом 6. НЕ с индексом 3, как и следовало ожидать.

Надеюсь, что это поможет;-)

Ответ 3

Другим решением, которое я использовал, было бы скопировать лист в место, где вы знаете его индекс, ака сначала. Там вы можете легко ссылаться на него за все, что вам нужно, и после этого вы можете свободно перемещать его туда, где хотите.

Что-то вроде этого:

Worksheets("Sheet1").Copy before:=Worksheets(1)
set newSheet = Worksheets(1)
newSheet.move After:=someSheet

Ответ 4

UPDATE:

Dim ThisSheet As Worksheet
Dim NewSheet As Worksheet
Set ThisSheet = ActiveWorkbook.Sheets("Sheet1")
ThisSheet.Copy
Set NewSheet = Application.ActiveSheet

Ответ 5

Я понимаю, что этот пост старше года, но я пришел сюда, чтобы найти ответ на тот же вопрос, касающийся копирования листов и неожиданных результатов, вызванных скрытыми листами. Ни одно из вышеизложенных действительно не соответствовало тому, что я хотел в основном из-за структуры моей книги. В Essentailly у него очень большое количество листов, и то, что отображается, управляется пользователем, который выбирает конкретную функциональность, плюс порядок видимых листов был импортирован для меня, поэтому я не хотел с ними связываться. Поэтому мое конечное решение заключалось в том, чтобы полагаться на соглашение об именовании по умолчанию Excels для скопированных листов и явно переименовывать новый лист по имени. Пример кода ниже (как в стороне, моя книга имеет 42 листа, и только 7 постоянно видны, а after:=Sheets(Sheets.count) поместите мой скопированный лист в середину 42 листов, в зависимости от того, какие листы видны в то время.

        Select Case DCSType
        Case "Radiology"
            'Copy the appropriate Template to a new sheet at the end
            TemplateRAD.Copy after:=Sheets(Sheets.count)
            wsToCopyName = TemplateRAD.Name & " (2)"
            'rename it as "Template"
            Sheets(wsToCopyName).Name = "Template"
            'Copy the appropriate val_Request to a new sheet at the end
            valRequestRad.Copy after:=Sheets(Sheets.count)
            'rename it as "val_Request"
            wsToCopyName = valRequestRad.Name & " (2)"
            Sheets(wsToCopyName).Name = "val_Request"
        Case "Pathology"
            'Copy the appropriate Template to a new sheet at the end
            TemplatePath.Copy after:=Sheets(Sheets.count)
            wsToCopyName = TemplatePath.Name & " (2)"
            'rename it as "Template"
            Sheets(wsToCopyName).Name = "Template"
            'Copy the appropriate val_Request to a new sheet at the end
            valRequestPath.Copy after:=Sheets(Sheets.count)
            wsToCopyName = valRequestPath.Name & " (2)"
            'rename it as "val_Request"
            Sheets(wsToCopyName).Name = "val_Request"
    End Select

В любом случае, размещен на всякий случай, когда он полезен кому-либо еще

Ответ 6

Это должен быть комментарий в ответ на @TimWilliams, но это мой первый пост, поэтому я не могу комментировать.

Это пример проблемы, описанной в @RBarryYoung, связанной со скрытыми листами. Существует проблема, когда вы пытаетесь поместить свою копию после последнего листа, а последний лист скрыт. Похоже, что если последний лист скрыт, он всегда сохраняет самый высокий индекс, поэтому вам нужно что-то вроде

Dim sht As Worksheet

With ActiveWorkbook
   .Sheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
   Set sht = .Sheets(.Sheets.Count - 1)
End With

Аналогичная ситуация при попытке копирования перед скрытым первым листом.

Ответ 7

Обновлено с предложениями от Daniel Labelle:

Чтобы обрабатывать возможные скрытые листы, сделать исходный лист видимым, скопировать его, использовать метод ActiveSheet, чтобы вернуть ссылку на новый лист, и reset параметры видимости:

Dim newSheet As Worksheet
With ActiveWorkbook.Worksheets("Sheet1")
    .Visible = xlSheetVisible
    .Copy after:=someSheet
    Set newSheet = ActiveSheet
    .Visible = xlSheetHidden ' or xlSheetVeryHidden
End With

Ответ 8

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

Как только модель будет видна и скопирована, новый объект рабочей таблицы - это просто ActiveSheet, копируете ли вы источник до или после.

В качестве предпочтения вы можете заменить:

"Установите newSheet =.Previous" с "Set newSheet = Application.ActiveSheet".

Надеюсь, это поможет некоторым из вас.

Ответ 9

Я пытаюсь создать надежную универсальную функцию "обертка" для метода sheet.Copy для повторного использования в нескольких проектах в течение многих лет.

Я попробовал несколько подходов здесь, и я нашел только ответ Марка Мура, чтобы быть надежным решением во всех сценариях. То есть, используя имя "Template (2)" для идентификации нового листа.

В моем случае любое решение, использующее метод ActiveSheet, было бесполезным, так как в некоторых случаях целевая рабочая книга находилась в неактивной или скрытой рабочей книге.

Аналогично, некоторые из моих Рабочих книг имеют скрытые листы, смешанные с видимыми листами в разных местах; в начале, посередине, в конце; и поэтому я нашел решения с использованием опций Before: и After: также ненадежными в зависимости от упорядочения видимых и скрытых листов вместе с дополнительным фактором, когда исходный лист также скрыт.

Поэтому после нескольких повторных записей я получил следующую функцию-оболочку:

'***************************************************************************
'This is a wrapper for the worksheet.Copy method.
'
'Used to create a copy of the specified sheet, optionally set it name, and return the new
' sheets object to the calling function.
'
'This routine is needed to predictably identify the new sheet that is added. This is because
' having Hidden sheets in a Workbook can produce unexpected results in the order of the sheets,
' eg when adding a hidden sheet after the last sheet, the new sheet doesn't always end up
' being the last sheet in the Worksheets collection.
'***************************************************************************
Function wsCopy(wsSource As Worksheet, wsAfter As Worksheet, Optional ByVal sNewSheetName As String) As Worksheet

    Dim Ws              As Worksheet

    wsSource.Copy After:=wsAfter
    Set Ws = wsAfter.Parent.Sheets(wsSource.Name & " (2)")

    'set ws Name if one supplied
    If sNewSheetName <> "" Then
        Ws.Name = sNewSheetName
    End If
    Set wsCopy = Ws
End Function

ПРИМЕЧАНИЕ. Даже это решение будет иметь проблемы, если имя исходного файла больше 27 символов, так как максимальное имя листа равно 31, но обычно это под моим контролем.

Ответ 10

Основываясь на методе Тревора Нормана, я разработал функцию копирования листа и возврата ссылки на новый лист.

1. Покажите последний лист (1), если он не отображается
2. Скопируйте исходный лист (2) после последнего листа (1)
3. Установите ссылку на новый лист (3), то есть лист после последнего листа (1)
4. Скрыть последний лист (1), если необходимо

Код:

Function CopySheet(ByRef sourceSheet As Worksheet, Optional ByRef destinationWorkbook As Workbook) As Worksheet

    Dim newSheet As Worksheet, lastSheet As Worksheet
    Dim lastIsVisible As Boolean

    If destinationWorkbook Is Nothing Then Set destinationWorkbook = sourceSheet.Parent

    With destinationWorkbook
        Set lastSheet = .Worksheets(.Worksheets.Count)
    End With

    lastIsVisible = lastSheet.Visible
    lastSheet.Visible = True

    sourceSheet.Copy After:=lastSheet
    Set newSheet = lastSheet.Next

    If Not lastIsVisible Then lastSheet.Visible = False

    Set CopySheet = newSheet

End Function

Это всегда будет вставлять скопированный лист в конец рабочей книги назначения.

После этого вы можете выполнять любые действия, переименовывать и т.д.

Применение:

Sub Sample()

    Dim newSheet As Worksheet

    Set newSheet = CopySheet(ThisWorkbook.Worksheets("Template"))

    Debug.Print newSheet.Name

    newSheet.Name = "Sample" ' rename new sheet
    newSheet.Move Before:=ThisWorkbook.Worksheets(1) ' move to beginning

    Debug.Print newSheet.Name

End Sub

Или, если вы хотите, чтобы поведение/интерфейс были более похожими на встроенный метод копирования (т.е. до/после), вы можете использовать:

Function CopySheet2(ByRef sourceSheet As Worksheet, Optional ByRef beforeSheet As Worksheet, Optional ByRef afterSheet As Worksheet) As Worksheet

    Dim destinationWorkbook As Workbook
    Dim newSheet As Worksheet, lastSheet As Worksheet
    Dim lastIsVisible As Boolean

    If Not beforeSheet Is Nothing Then
        Set destinationWorkbook = beforeSheet.Parent
    ElseIf Not afterSheet Is Nothing Then
        Set destinationWorkbook = afterSheet.Parent
    Else
        Set destinationWorkbook = sourceSheet.Parent
    End If

    With destinationWorkbook
        Set lastSheet = .Worksheets(.Worksheets.Count)
    End With

    lastIsVisible = lastSheet.Visible
    lastSheet.Visible = True

    sourceSheet.Copy After:=lastSheet
    Set newSheet = lastSheet.Next

    If Not lastIsVisible Then lastSheet.Visible = False

    If Not beforeSheet Is Nothing Then
        newSheet.Move Before:=beforeSheet
    ElseIf Not afterSheet Is Nothing Then
        newSheet.Move After:=afterSheet
    Else
        newSheet.Move After:=sourceSheet
    End If

    Set CopySheet2 = newSheet

End Function

Ответ 11

Как уже упоминалось здесь, скопируйте/вставьте лист в крайнее левое положение (index = 1), затем назначьте его переменной, затем переместите в нужное вам место. Вставка листа Before означает, что вам не нужно проверять и потенциально показывать лист.

Я не могу проверить это прямо сейчас, но я не понимаю, почему это не сработает. :)

Function CopyWorksheet(SourceWorksheet as Worksheet, AfterDestinationWorksheet as Worksheet) as Worksheet

    SourceWorksheet.Copy Before:= AfterDestinationWorksheet.Parent.Sheets(1)

    Dim NewWorksheet as Worksheet
    Set NewWorksheet = AfterDestinationWorksheet.Parent.Sheets(1)

    NewWorksheet.Move After:= AfterDestinationWorksheet 

    Return NewWorksheet

End Function