web-dev-qa-db-ja.com

シートをコピーして結果のシートオブジェクトを取得しますか？

ワークシートをコピーしたときに取得するnewシートのワークシートオブジェクトを取得する簡単/短い方法はありますか？

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

.Copyメソッドがワークシートオブジェクトの代わりにブール値を返すことがわかりました。そうでなければ、私はできたでしょう：

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

そのため、オブジェクトを取得するために約25行のコードを記述しました。コピー前にすべてのシートをリストし、後にすべてのシートをリストし、2番目のリストのみにあるシートを特定します。

よりエレガントで短いソリューションを探しています。

excelvbaworksheet
31
Rabarberski
Dim sht 

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

私はこの問題をついに釘付けにしたと信じています-それもまた私を狂わせてきました！ Addメソッドと同じように、MSがコピーにシートオブジェクトを返させたら、それは本当に素晴らしいことでした...

問題は、VBAが新しくコピーされたシートを割り当てるインデックスは実際には決定されていないことです...他の人が指摘しているように、非表示のシートに大きく依存します。実際、Sheets（n）という表現は実際には「n番目に表示されるシート」として解釈されると思います。したがって、すべてのシートの可視プロパティをテストするループを作成しない限り、ユーザーがシートの可視プロパティを混乱させることができないようにワークブックが保護されていない限り、コードでこれを使用すると危険が伴います。あまりにもハード...

このジレンマに対する私の解決策は次のとおりです。

  1. （一時的であっても）LASTシートを表示する
  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ではありません。

お役に立てば幸いです;-)

15
Trevor Norman

私が使用したもう1つの解決策は、インデックスを知っている場所にシートをコピーすることです。そこで、必要なものを簡単に参照でき、その後、好きな場所に自由に移動できます。

このようなもの：

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

更新：

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

この投稿は1年以上前のものだと思いますが、私はここに来て、シートのコピーに関する同じ問題と、非表示のシートによって引き起こされる予期しない結果の答えを探しました。上記のどれも、主にワークブックの構造が原因で、私が欲しかったものに実際には適していません。本質的に、非常に多数のシートがあり、表示されるのはユーザーが特定の機能を選択することによって駆動されます。さらに、表示されるシートの順序は私にとって重要でしたので、それらを台無しにしたくありませんでした。したがって、私の最終的な解決策は、コピーしたシートをExcelのデフォルトの命名規則に依存し、新しいシートの名前を明示的に変更することでした。以下のコードサンプル（余談ですが、私のワークブックには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

とにかく、誰かに役立つので念のため投稿しました

3
Mark Moore

Daniel Labelleからの提案で更新：

非表示の可能性のあるシートを処理するには、ソースシートを表示してコピーし、ActiveSheetメソッドを使用して新しいシートへの参照を返し、表示設定をリセットします。

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

これは@TimWilliamsへの応答としてのコメントでなければなりませんが、これは私の最初の投稿なのでコメントできません。

これは、非表示のシートに関連して@RBarryYoungが言及した問題の例です。最後のシートの後にコピーを配置しようとすると、最後のシートが非表示になるという問題があります。最後のシートが非表示の場合、常に最高のインデックスが保持されるようなので、次のようなものが必要です

Dim sht As Worksheet

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

非表示の最初のシートの前にコピーしようとしたときの同様の状況。

2
alrm3000

非表示のワークシートが原因で、新しいワークシートのインデックスがソースワークシートのいずれかの側で非順次になるのは正しいことです。以前にコピーしている場合は、レイチェルの答えが機能することがわかりました。ただし、後でコピーする場合は、調整する必要があります。

モデルが表示されてコピーされると、ソースをコピーする前でも後でも、新しいワークシートオブジェクトはActiveSheetになります。

プリファレンスとして、次のものを置き換えることができます。

Set newSheet = .Previousセット付きnewSheet = Application.ActiveSheet。

これがあなたの一部に役立つことを願っています。

1
Daniel Labelle

すでにここで述べたように、シートを左端（インデックス= 1）にコピーして貼り付け、変数に割り当ててから、好きな場所に移動します。

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

    Dim DestinationWorkbook As Workbook
    Set DestinationWorkbook = AfterDestinationWorksheet.Parent

    Dim FirstSheetVisibility As XlSheetVisibility
    FirstSheetVisibility = DestinationWorkbook.Sheets(1).Visible

    DestinationWorkbook.Sheets(1).Visible = xlSheetVisible
    SourceWorksheet.Copy Before:=DestinationWorkbook.Sheets(1)
    DestinationWorkbook.Sheets(2).Visible = FirstSheetVisibility

    Dim NewWorksheet As Worksheet
    Set NewWorksheet = DestinationWorkbook.Sheets(1)

    NewWorksheet.Move After:=AfterDestinationWorksheet

    Set CopyWorksheet = NewWorksheet

End Function
1
Ama

古い投稿ですが、シートを再表示したり、名前にサフィックスを追加したりすることについては確信がありませんでした。

これは私のアプローチです：

Sub DuplicateSheet()
    Dim position As Integer
    Dim wbNewSheet As Worksheet
    position = GetFirstVisiblePostion

    ThisWorkbook.Worksheets("Original").Copy Before:=ThisWorkbook.Sheets(position)
    Set wbNewSheet = ThisWorkbook.Sheets(position)

    Debug.Print "Duplicated name:" & wbNewSheet.Name, "Duplicated position:" & wbNewSheet.Index

End Sub

Function GetFirstVisiblePostion() As Integer
    Dim wbSheet As Worksheet
    Dim position As Integer
    For Each wbSheet In ThisWorkbook.Sheets
        If wbSheet.Visible = xlSheetVisible Then
            position = wbSheet.Index
            Exit For
        End If
    Next
    GetFirstVisiblePostion = position
End Function
0
Ricardo Diaz

Trevor Normanの方法 に基づいて、シートをコピーして新しいシートへの参照を返す関数を開発しました。

  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
0
Tigregalis

複数のプロジェクトで再利用できるように、sheet.Copyメソッドの信頼できる汎用「ラッパー」関数を何年も作成しようとしています。

ここでいくつかのアプローチを試しましたが、すべてのシナリオで信頼できるソリューションであるのはマークムーアの答えだけでした。つまり、「テンプレート（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's 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

注：最大のシート名が31であるため、ソースシートの名前が27文字を超える場合、このソリューションでも問題が発生しますが、通常、これは私の管理下にあります。

0
Rob Bishop