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

Question

Есть ли простой / короткий способ получить объект Excel.worksheet для нового листа, который вы получаете при копировании листа?

ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet

Оказывается, метод .Copy возвращает логическое значение вместо объекта рабочего листа.В противном случае я мог бы сделать:

set newSheet = ActiveWorkbook.Sheets("Sheet1").Copy after:=someSheet    <-- doesn't work

Итак, я написал около 25 строк кода для получения объекта (перечислите все листы до копирования, перечислите все листы после и выясните, какой из них находится втолько последний список. Все очень длинные в VBA), но я ищу более элегантное, более короткое решение.

Answer 1

Dim sht 

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

Answer 2

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

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

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

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

Вот мой код, который сейчас кажется пуленепробиваемым ...

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: =. Sheets (2) фактически создает новый лист ДО следующего Лист VISIBLE - т. Е. Он стал новым индексом 6. НЕ с индексом 3, как вы могли ожидать.

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

Answer 3

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

Примерно так:

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

Answer 4

UPDATE:

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

Answer 5

Я понимаю, что этому посту более года, но я пришел сюда в поисках ответа на ту же проблему, касающуюся копирования листов и неожиданных результатов, вызванных скрытыми листами. Ничто из вышеперечисленного действительно не соответствовало тому, что я хотел, в основном из-за структуры моей рабочей книги. По сути, он имеет очень большое количество листов, и то, что отображается, определяется тем, что пользователь выбирает определенные функции, плюс порядок видимых листов был мне важен, так что я не хотел связываться с ними. Поэтому мое конечное решение заключалось в том, чтобы полагаться на соглашение об именовании по умолчанию 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

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

Answer 6

Обновлено с предложениями от Даниэля Лабеля:

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

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

Answer 7

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

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

Dim sht As Worksheet

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

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

Answer 8

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

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

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

«Установить новыйSheet = .Previous» на «Установить новыйSheet = Application.ActiveSheet».

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

Answer 9

Как уже упоминалось здесь, скопируйте / вставьте лист в крайнее левое положение (индекс = 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

Answer 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

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

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