Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2013)
分割して、値でブックを作成コードの助言をお願いします
投稿日時: 20/06/07 12:37:35
投稿者: m024240

見よう見まねでコードを作成している状況ですが、よろしくお願いします。
 
年間行事予定.xlsmブックに15のシートがあります。
カレンダー作成、印刷のためにVBAを設定しています。
シートは、年間、4月、5月、・・・3月、(+設定のためのシート2)となっています。
編集するのは年間シートのみで、内容を各月のシートに飛ばしています。
(関数っていうのでしょうか?、以下のように設定してあります。)
B  C         K    L  M
日  曜   ・・           備考
1 =年間!C7 ・・  =年間!J7


31 =年間!C37 ・・  =年間!J37
 
新たに、各月シートを分割(値で、VBAも削除して)作成することになり、
以下のようなコードをネットの情報を元に作成しました。
 
このコードで、
1)値で貼り付けられないことがある。
2)各月シートに移ってコードを実行しようとすると動きが固まる
3)保存するときはコードをなくしてxlsxで保存したいがアラートが出て、コードが中止される
これ以外にも、表面化していない不具合があるのかなと思いますが、
ご助言いただけないでしょうか?
(入力規則クリアしたり、ボタン図形を消去したりしてあります)
よろしくお願いします。
 
    Dim wb1 As Workbook, ws1 As Worksheet
    Dim wb2 As Workbook, ws2 As Worksheet
    Dim shp As Shape
     
    Set wb1 = ActiveWorkbook '元ブック
    Set ws1 = wb1.ActiveSheet '元ブックのアクティブシート
     
        ws1.Copy '元ブックのアクティブシートをコピーする
 
    Set wb2 = ActiveWorkbook '新規ブック
    Set ws2 = wb2.ActiveSheet '新規ブックのアクティブシート
         
        Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
               
    With wb2 '新規ブックのアクティブシート上で
         
        Cells.Validation.Delete 'すべての入力規則を消去
        Cells.Font.Name = "MS ゴシック" 'すべてのフォントをMSゴシックに
             
        For Each shp In ActiveSheet.Shapes 'すべてのボタンを消去
            shp.Delete
        Next shp
     
    End With
     
    wb2.SaveAs ThisWorkbook.Path & "\" & ws2.Name & ".xlsx"
    (現在はコードが中断されるのでコメント行にしてあります)

回答
投稿日時: 20/06/07 13:00:48
投稿者: simple

With句のところがおかしいですかね。
Withとしたら、 .(ドット記号)を使わないと意味がないですよ。
例えばこんな感じですか。

    With ws2    '新規ブックのアクティブシート上で
        .Cells.Validation.Delete    'すべての入力規則を消去
        .Cells.Font.Name = "MS ゴシック"    'すべてのフォントをMSゴシックに
        For Each shp In .Shapes    'すべてのボタンを消去
            shp.Delete
        Next shp
    End With

その前の Cells.Selectのあたりも、折角定義したワークシート変数を使って
シートを特定したほうがよいと思います。ついでに、不要なSelectも取って、
ws2.Cells.Copy
などとするとよいでしょう。
 
# 申し訳ないが、処理の内容自体は見ていませんので悪しからず。

回答
投稿日時: 20/06/07 13:39:39
投稿者: simple

Withステートメントのほうが正確でしたね。

回答
投稿日時: 20/06/07 22:32:15
投稿者: takesi

 Dim wb1 As Workbook 'このBook
  Dim wb2 As Workbook '新規作成Book
  Dim svPath As String
  Dim i, shNo
  Set wb1 = ThisWorkbook '今実行しているマクロのあるbook
  For i = 1 To 12 '1月から12月
    Workbooks.Add              '新規ブック作成
    Set wb2 = ActiveWorkbook   '新規ブック
    'wb1の該当月のシートをWb2の最初のタブ位置にコピー
    wb1.Worksheets(i & "月").Copy Before:=wb2.Sheets(1)
    ' wb2の二つ目以降のシート削除
    If wb2.Sheets.Count > 1 Then
      For shNo = wb2.Sheets.Count To 2 Step -1
        '削除確認メッセージを非表示で実行
        Application.DisplayAlerts = False
        wb2.Sheets(shNo).Delete
        Application.DisplayAlerts = True
      Next
    End If
    '保存
    svPath = wb1.Path & "\savetest" & i & "月.xlsx"
    wb2.SaveAs svPath
    wb2.Close
  Next

回答
投稿日時: 20/06/07 22:51:19
投稿者: WinArrow
投稿者のウェブサイトに移動

ステップ実行して
どこまで、意図した動きになっているか、、、確認してみるとよいでしょう。

投稿日時: 20/06/12 13:20:23
投稿者: m024240

遅い返信で申し訳ありません。
 
simple 様
アドバイスありがとうございました。
コードをすらすらかけないので、いろいろな本や
WEBのコードをくっつけてあるので、統一が取れていないと思います。
もっと勉強しないといけませんね。
 
takesi 様
自分の思い込みで、1シートずつ分割すればよいと考えていましたが、
一発で12シート分を分割する方法ですね。
 
WinArrow 様
これまでステップ実行を使っていなかったので、参考になりました。
 
皆さんのご助言もあり、なんとか考えていたものができました。
ありがとうございました。