[[20200525124804]]　『一番右にシートをコピーと一括コピー』（塩じぃ）　ページの最後に飛ぶ

『一番右にシートをコピーと一括コピー』（塩じぃ）

こんにちは。つたない説明で申し訳ないですが教えてください

マクロの中で今開いてる雛型1というシートの中に
Activesheet.copyのコマンドボタンを作って
新しいブックにコピーしていたのですが
何回もコピーして後でコピーしたブック内のシートをまとめる
という手間があります。

?@今開いているシートをコピーするとブック内の一番右にコピーが
作成される

?A指定したシート以外は新しいブックにまとめてコピーする
(自分の環境だと雛型1と雛型2のシート以外を新しいブックにコピー)

の2つのプロシージャを教えていただけないでしょうか。

現状は分裂しまくったブックを後でシートの移動やコピーでまとめています。
すみませんがよろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows7 ＞

残念ながら私の環境では文字化けしてる部分（多分丸付き数字）がありますが、

 (1) ActiveSheetをブック末尾にコピー挿入する方法法

 (2) （どうやって"指定"するのかは別問題ですが）ブックの指定したシートを
    新規ブックにコピーする

の2つが知りたいということでしょうか？

その場合、
＞Activesheet.copyのコマンドボタンを作って新しいブックにコピーしていた
とおっしゃっているので、まったくの手つかずではないとおもうので、どんなコードを書いていてどこが思う通りになってないのか、教えていただくとアドバイスできる部分があるかもしれません。

（もこな２） 2020/05/25(月) 13:31

もこな2様

はい、2つのプロシージャを教えていただけたらと思います。

現在は
Sub コピー

  Dim Tmp as String
  Tmp = "雛型1"

  Sheets(Tmp).Select

  ActiveSheet.copy
  ActiveSheet.Name = ActiveSseet.Range("A2")

  Msgbox"雛型に戻ってください",vbokonly,"コピー完了"
End Sub

だけにしてシート名を取得しています。
1日、2日、3日、とコピーしていくのですがブックがどんどん増えてしまうので
新しいブックを増やさずに右に増やしていって
最後に別のコマンドボタンで一括出力
みたいに作りたいです。

（塩じぃ） 2020/05/25(月) 15:39

一括出力部分は別にして、前段は↓みたいに考えてみてはどうでしょうか？

    Sub コピー_改()
        With ThisWorkbook.Worksheets("雛形1")
            .Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = .Range("A2")
            .Activate
            MsgBox "コピー完了"
        End With
    End Sub

（もこな２） 2020/05/25(月) 16:32

追加で。
後段の「一括出力」の部分は、対象となるシートに規則性はありますか？
たとえば、「雛形1」シートより右にあるものは全部対象とか
シートが"日"で終わるものが対象とか・・

はたまた、雛形1、雛形2以外は全部対象とか

（もこな２） 2020/05/25(月) 20:05

もこな2様
頂いたプロシージャ試してみました、一番後ろにコピーしてくれて素晴らしいです。
ありがたく使わせていただきます。

2つめの希望については細かい規則性はなく、自分の環境で言うと

雛形1、雛形2、リスト　というシート以外は全部対象にして
別ブックにコピーできれば非常にありがたいです。

この2つが揃えば作業性が数倍になる・・・
教えて頂ければありがたいです。すみません聞いてばかりで。

（塩じぃ） 2020/05/25(月) 20:13

＞雛形1、雛形2、リスト　というシート以外は全部対象
それならいったん、【全部】コピーして、いらないそれらを削除したほうが手っ取り早いかもですね。

    Sub さんぷる()
        Dim tmp As Variant

        ThisWorkbook.Worksheets.Copy

        Application.DisplayAlerts = False
        On Error Resume Next
        For Each tmp In Array("雛形1", "雛形2", "リスト")
            Workbooks(Workbooks.Count).Worksheets(tmp).Delete
        Next tmp
        On Error GoTo 0
        Application.DisplayAlerts = False

    End Sub

（もこな２） 2020/05/25(月) 21:52

↑だと元のほうにシートが残っちゃいますね。（コピーしてるから）

↓をステップ実行して確認してみてください。

    Sub 一括移動()
        Dim MySTR As String
        Dim SH As Worksheet

        Stop 'ブレークポイントのかわり

        '▼対象のシートを文字列で覚える
        For Each SH In ThisWorkbook.Worksheets
            Select Case SH.Name
                Case Is = "雛形1", "雛形2", "リスト"
                    '何もしない
                Case Else
                     MySTR = MySTR & SH.Name & ","
            End Select
        Next SH

        '▼覚えたシート名があったら処理する
        If MySTR <> "" Then
            MySTR = Left(MySTR, Len(MySTR) - 1)
            ThisWorkbook.Worksheets(Split(MySTR, ",")).Move
        End If

    End Sub

（もこな２） 2020/05/26(火) 12:12

もこな2様

何というか上から目線の様な言い回しですみませんが
100点満点目指してたら200点になるプロシージャを教えて頂き
ありがとうございました。
感無量です！！元データもリセットしてくれるのありがたすぎです！
（塩じぃ） 2020/05/26(火) 13:05

こちらとしては、完成品をプレゼントしたのではなく研究資料として提示しているつもりですので、興味がわいたときにでもステップ実行して何をやっているのか調べてみてください。

ちなみに、当初想定されていたのは↓のような動きじゃないでしょうか？
（実行するまえにマクロブックのほうを一度保存してください）

    Sub さんぷる()
        Dim dstWB As Workbook

        On Error Resume Next
        Set dstWB = Workbooks("出力.xlsx")
        On Error GoTo 0
        With ThisWorkbook.Worksheets("雛形1")
            If dstWB Is Nothing Then
                .Copy
                Set dstWB = Workbooks(Workbooks.Count)
                dstWB.Worksheets(1).Name = .Range("A2").Value
                dstWB.SaveAs ThisWorkbook.Path & "\出力"
            Else
                .Copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)
                dstWB.Worksheets(dstWB.Worksheets.Count).Name = .Range("A2").Value
            End If

            .Parent.Activate
            .Activate

        End With
    End Sub

（もこな２） 2020/05/27(水) 02:16

コメント返信：

[ 一覧(最新更新順) ]

[[20200525124804]] 『一番右にシートをコピーと一括コピー』（塩じぃ） ページの最後に飛ぶ

[[20200525124804]]　『一番右にシートをコピーと一括コピー』（塩じぃ）　ページの最後に飛ぶ