Excel VBAで月次のシートをコピーする方法
- 毎月同じことをするためにExcel VBAでマクロボタンを作成しましたが、シートをコピーして新しいBOOKに保存するとマクロが消えてしまいます。どのようにすれば問題なく実行することができるでしょうか？初心者なので詳しい説明をお願いします。
- Excel VBAを使用して、毎月同じ作業を簡単に実行するためのマクロボタンを作成しました。しかし、シートを新しいBOOKにコピーして保存すると、作成したマクロが消えてしまい、実行することができません。解決策を教えてください。
- ExcelのVBAを使って毎月同じ作業を効率化するためにマクロボタンを作成しましたが、シートを新しいBOOKにコピーするとマクロが失われてしまいます。この問題を解決する方法を教えてください。初心者ですので、具体的な手順を教えていただけると助かります。
- ベストアンサー
マクロボタンのシートをコピーしたいのですが。。。
こんにちは。 たくさんあるファイルを一つのファイルにシート別にまとめるマクロを作成しました。 毎月同じことをするので、マクロボタンを作成したところ、作成したつきのボタンは正常に作動しますが、このシートを新しいBOOKにコピーして翌月分を作成したところ、マクロが消えてしまい、実行されません。 毎月のことなので、いちいち『前月のマクロをコピーして実行』などしないで、このボタンをコピーすればあとは押すだけ♪なんていう風にうまくいかないものでしょうか？ かなり初心者な者で、上手な説明が出来ず申し訳ございません。 Sub 精算用5月() Dim fs As Variant Dim s As Variant Dim w As Workbook fs = Application.GetOpenFilename(Title:="select xls(s)", MultiSelect:=True) If Not IsArray(fs) Then Exit Sub For Each s In fs Set w = Workbooks.Open(Filename:=s) w.Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Application.Substitute(w.Name, ".xls", "") w.Close savechanges:=False Next Worksheets(1).Range("A1").Formula = "=SUM(" & Worksheets(2).Name & ":" & Worksheets(Worksheets.Count).Name & "!A1)" End Sub 上記のマクロでボタンを作成しました。 よろしくお願いいたします。
- 財務・会計・経理
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
マクロがその作成したブックに保存されているのでしょう。 なので、新しい別のブックのシートにコピーしてもそのブックにはマクロが無いので実行できないのです。 個人用マクロブックに保存し直すか、そのブック自体を「名前を変えて保存」で別名に保存しなおしてそれを使えば良いです。
関連するQ&A
- マクロ 戻るボタンを押したらシートの１枚目に戻る
各シートに「戻る」というボタンを作りましたが、 「ボタンを押したらシートの１枚目をアクティブにする」というマクロを付けたいです。 下記は、『「戻る」というマクロを２枚目のシート以降すべてに付ける』というマクロです。 このマクロの中に、各シートの「戻る」ボタンを押せば、シートの１枚目に戻るような 指示を入れたいです。 分かる方いましたら、お願いします。。。 ※下記のマクロは以前ご回答いただいたマクロを引用したものです。 /////////////////////////////////// Sub 戻るボタン設置() Dim Sht As Worksheet For Each Sht In Worksheets If Not Sht.Name = Worksheets(1).Name Then With Sht For i = 1 To 1 '幅140、高さ20のボタンを追加 .Buttons.Add(900 * i, 10, 140, 20).Text = "戻る" Next i End With End If Next Sht Sheets(1).Select End Sub
- ベストアンサー
- オフィス系ソフト
- VBA シート指定とファイル名入力
部署ごとに分割し、ブックで保存するコードです。 sheet名は「部署」です。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 5 To w.Range("B65536").End(xlUp).Row s = w.Cells(r, "B") w.Rows(r).Copy Worksheets(s).Range("B65536").End(xlUp).Offset(1, -1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ActiveWorkbook.Path & "\1\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") w.Rows(2).Copy Range("A2") w.Rows(3).Copy Range("A3") w.Rows(4).Copy Range("A4") Resume Application.ScreenUpdating = True End Sub (1)sheet1にマクロ実行ボタンを配置し、部署seedにマクロ実行命令をする。 (2)sheet1のB2セルにファイル名を入力して、そのファイルに保存する。（例部署ファイル） (1)Dim w As Worksheets("部署")と変更したのですが、エラーが出ました。 (2)myPath = ActiveWorkbook.Path & "\部署ファイル\" ↑ これをsheet1のB2セルから指定できるようにしたいです。 宜しくお願いします。
- ベストアンサー
- Visual Basic
- excelvbaにてシート名を指定してコピーしたい
いつもお世話になっております。 excel vbaにて、複数シートをひとつのbookにまとめようとしております。 シート名を指定してコピーしたいのですが、すべてのシートがコピーされてしまい困っています。 Worksheets("日帰り")だけを指定するには、どこの記述を変更したらいいでしょうか？ どなたか教えてください。 ----------------------------------------------------------------- Sub C_SheetCopy() On Error GoTo ErrorHandler Dim strPath As String Dim strBookName As String Dim TargetBook As Workbook Dim TargetSheet As Worksheet Dim OriginalSheet As Worksheet '指定した場所にあるxlsファイルについて処理 strPath = ThisWorkbook.Path '自分自身と同じ場所とする strBookName = Dir(strPath & "\*.xls") 'ファイル名取得 '対象ファイルが存在する限り処理 Do While strBookName <> "" If ThisWorkbook.Name <> strBookName Then '自分自身じゃないならそのブックを開く Set TargetBook = Workbooks.Open(strPath & "\" & strBookName) '開いたブックの全てのシートを処理 Set TargetSheet = TargetBook.Worksheets("日帰り") For Each TargetSheet In TargetBook.Worksheets '開いたブックのシートを自身の最後にコピー TargetSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'コピーしたシートの名前をコピー元ブック名＆シート名に変更 ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = TargetBook.Name & TargetSheet.Name Next '開いたブックを閉じる TargetBook.Close Set TargetBook = Nothing End If strBookName = Dir '次のファイル Loop ErrorHandler: 'エラーが起きたら If Not (TargetBook Is Nothing) Then TargetBook.Close End If If Err Then MsgBox Err.Number & ":" & Err.Description, vbExclamation Err.Clear End If End Sub
- ベストアンサー
- Visual Basic
- ExcelVBA シートのコピーについて
こんにちは！ VBAにて連番のシートを作成するマクロを組みました 1日→2日→3日・・・→60日 Sub シートコピー() Dim i As Integer, wst As Worksheet Set wst = Worksheets("コピー元") For i = 1 To 60 wst.Copy After:=Worksheets(i + 2) Worksheets(i + 3).Name = i & "日" Next Set wst = Nothing End Sub 54日まで作ることは出来たのですが、なぜか55日からが作成できません その後シートを消し、もう一度実行すると、1枚もシートが作れません この現象は何でしょうか？ また、どうやれば60枚分コピーできるでしょうか？
- ベストアンサー
- オフィス系ソフト
- シートの増減あっても特定セルに連番したい
Ｅｘｃｅｌ2007でマクロ作成の初心者です。 すべてのシートのＲ15セルに、シートの順番どおり 1から連番で番号をつけるマクロを教えていただきました。 Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i As Integer For i = 1 To ThisWorkbook.Worksheets.Count Worksheets(i).Range("R15").Value = i Next i End Sub これを以下のように改良したのですが、新しく追加したシートにはなぜか 番号が表示されません。どうしたら、うまく連番が入るようになるでしょうか。 Sub シートに連番() Dim i As Integer For i = 1 To ThisWorkbook.Worksheets.Count Worksheets(i).Range("R15").Value = i Next i End Sub
- ベストアンサー
- Visual Basic
- VBAでsheetのコピー
ご回答有難う御座いました。補足説明を致します。動作するとこまでは、出来たのですが、一点変更しました。：＝のコピーの所でデバッグすると、エラーになるので、＝だけにしました。すると動作するのですが、新しいsheetの名前が、コピー元のsheet名になります。そして、MsgBoxを入れると、エラーになります。また、1sheetだけがコピーされます。大変恐縮ですが、もう一度ご教授願います。補足説明なりますが、やりたい事は、拡張子がxlsmの中に名前のついた10個のsheetがあります。この10個のsheetを拡張子がxlsxのBookにコピーしたいのですが、このBook1のsheetをVBAから新に作成しBook2のsheet1に纏めたいのですが、纏め方は、Book2のsheet1の下から上に10sheetをコピーして、条件としてBook2のsheet1の名前は、固定で構いません。Book1の一番初めのsheetにコピーする時だけ3行目にある見出しだけは、Book2のsheet1に付けたく。それ以外のBook1のsheetは、デターだ4行目以降をコピーしたいのですが、また、コピーしたいsheetの範囲に列は、A1～AFで列は3～62までです。マクロはご教授頂いた、下記通りです。 Sub macro1() Dim i As Long Dim w0 As Workbook Dim s As Worksheet Set w0 = ActiveWorkbook '１枚目シートから貼り付け先のブックを作る w0.Worksheets(1).Copy Set s = ActiveSheet '２枚目以降のデータをコピーする For i = 2 To w0.Worksheets.count With w0.Worksheets(i) .Range("A4:AF" & .Range("A65536").End(xlUp).Row).Copy Destination = s.Range("A65536").End(xlUp).Offset(1) End With Next i End Sub これを先ほど書きました、マクロを教えて頂けませんでしょうか？何せ、マクロ初心者なので、msm相談箱がたよりです。何卒マクロを教えて頂きたく宜しくお願い申し上げます。
- ベストアンサー
- その他MS Office製品
- マクロ 一覧からシートを作成する
いつも回答して頂き、とても感謝しています。 似た様な質問を過去にしていますが、 前回の質問は、一列にシート名が記載しており、これを参照してシートを次々と挿入するマクロの作り方でしたが、今回は、複数列にシート名が記載されている場合のマクロ記述についてです。 自分なりに考えてみましたが、set = s の値がNOTHINGになり、挿入したシートに名前を記載する事ができませんでした。原因がさっぱり分からないので御教授の程宜しくお願い致します。 Sub シートの挿入() Dim s As Worksheet Dim r As Long Dim c As Long On Error GoTo errhandle c = 2 With Worksheets("作業名一覧") For r = 2 To .Cells(Rows.Count, c).End(xlUp).Row Do While .Cells(r, c).Value <> "" Set s = Worksheets(Cells(r, c).Value) c = c + 1 Loop Next r End With Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = Cells(r, c).Value Worksheets(h.Value).Cells.ColumnWidth = 1 Worksheets(h.Value).Cells.RowHeight = 15 Resume End Sub
- ベストアンサー
- オフィス系ソフト
- シート名変更マクロ
「1」というシートのH4にコピー数を入力し、「1」の後ろに挿入するマクロがあります。できたシートの名前は「1(2)」「1(3)」となってしまいます。このシート名を挿入した数の通し番号（「2」「3」に変更することはできるのでしょうか？挿入するシートの数は決まっていません。 Sub シートのコピー() Dim i As Integer Dim n As Integer n = Worksheets("1").Range("H4").Value For i = 1 To n Worksheets("1").Copy Before:=Worksheets(Sheets.Count) Next i End Sub
- ベストアンサー
- オフィス系ソフト
- 部署ごとに分割し、ブックで保存するコード
部署ごとに分割し、ブックで保存するコードです。 A1、1列目から分割していますが、B2、4列目から分割する方法を教えてください。 A65536をB65536に変えたりなどしていましたが、エラーが出ます。 よろしくお願いします。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 2 To w.Range("A65536").End(xlUp).Row s = w.Cells(r, "A") w.Rows(r).Copy Worksheets(s).Range("A65536").End(xlUp).Offset(1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ThisWorkbook.Path & "\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") Resume Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- マクロをマクロを使ってコピーしたい
Ｅｘｃｅｌ2010です。 今、book1の各シート(ここでは"S1"で特定していますが、たとえばs1、s2、s3の3つがあるとします。)の左上隅「X」マークを右クリックすると出てくる「コードの表示」に以下の内容を記録しています。 ------------- Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "s1" Then Exit Sub Worksheets("s1").Range("e6") = Sh.Range("an7") Worksheets("s1").Range("e9") = Sh.Range("bj7") Worksheets("s1").Range("e10") = Sh.Range("br7") End Sub ------------- これをbook1のマクロ本体の実行によってbook1のシート"s1"を含むいくつかのシートのあるコピーbook2に、同じようにマクロでこの「Private Sub」をコピーしたいと思っています。どのようのすればいいでしょうか。 よろしくお願いします。
- 締切済み
- その他MS Office製品
お礼
kadakun1さん、 ＞そのブック自体を「名前を変えて保存」で別名に保存しなおしてそれを使えば良いです。 この方法で出来ました！！ ありがとうございました。 ＞個人用マクロブックに保存し直す とはどのようにするのですか？ 今後のために詳しく教えていただけると幸甚です。
補足
＞そのブック自体を「名前を変えて保存」で別名に保存しなおしてそれを使えば良いです。 この通りにやってできました！！ありがとうございました。 今後のために、 ＞個人用マクロブックに保存し直す とは、具体的にどのようにしたら良いのか教えていただけないでしょうか？ よろしくお願いいたします。