VBAで特定のシートを別ファイルで保存する方法

このQ&Aのポイント
  • VBAを使用して、指定のシートを別のファイルに保存する方法について質問があります。
  • 質問者は、ブック内にAとBの2つのシートがあり、シートAの情報が新しく作成されるシートCにコピーされ、シートCとシートBの2つのシートが別のファイルとして保存されるようにしたいと考えています。
  • 現在は、シートCのみを別ファイルで保存することができており、シートBが追加できないという問題に直面しています。
回答を見る
  • ベストアンサー

vba 特定の複数シートを別ファイルで保存。

ブック内にA,Bと2つのシートがあり、ボタンをクリックすると特定の回数、シートAの情報が新規作成されたシートCにコピーされ、シートCとシートBの2シートが別ファイルとして保存される。という動きを繰り返したいのですが、 新規生成されるシートCだけを別ファイルで保存することまでは出来たのですが、シートBが追加できず困っています。 Sub 分割() Dim cpy As Range Dim pst As Range Dim path 'ファイルパス path = ActiveWorkbook.path Dim CopyWorkBook Dim CopyWorkSheet1 Dim CopyWorkSheet2 Dim Position(2,2) 'ここにはシートCを作成する際の情報が入っている。 '新規シートCを作成してシートAからデータをコピー。 For i = 1 To 2 Step 1 'とりあえず2シート作成する。 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Position(i, 2) 'まずは、タイトル欄をコピー Worksheets("Sheet1").Activate Set cpy = Worksheets("Sheet1").Range("A2:Q2") Worksheets(Position(i, 2)).Activate Set pst = Worksheets(Position(i, 2)).Range("A2:Q2") pst.Value = cpy.Value '貼り付け End With 'シートを別名で保存 Set CopyWorkSheet1 = Worksheets(Position(i, 2)) Set CopyWorkSheet2 = Worksheets("シートB") CopyWorkSheet1.Copy ' CopyWorkSheet2.Copy ←これでシートBもコピーされるかと思いましたが、シートBが上書きされてしまう。 Set CopyWorkBook = ActiveWorkbook ActiveWorkbook.SaveAs path & "\" & Position(i, 2) & "xls", xlWorkbookNormal CopyWorkBook.Close Next End Sub 質問は2つあります。 (1)シートBも新規作成されたシートCと一緒に別ブックに保存したいのですが、どうすればいいでしょうか? (2)シートのコピーの動きがイマイチよくわかりません。 今の私の環境だと(ネットで調べた書き方ですが)、シートを別ブックにコピーする際、 Set CopyWorkSheet1 = Worksheets("シートA") CopyWorkSheet1.Copy Set CopyWorkBook = ActiveWorkbook となっていますが、Setで、コピー元のシートAの情報をCopyWorkSheet1にコピーしたあと、 CopyWorkSheeet1.Copy となっていますが、この意味がわかりません。 なぜ更にコピーしているのでしょうか?またこれで、別ブックにシートが追加されてる理由もわかりません。 また、この処理の後に、 Set CopyWorkBook = ActiveWorkbook と、ブックの情報をコピーしていますが、普通に考えると最初にブックの情報をコピーして別名のブックを生成しておく必要があるように思えるのですが、後でよい理由も分かりませんし、これだと、Activeのワークブックのシート情報も全部コピーされてしまう気がするのですが。。。 この辺が全然分かっていないので、解説頂けるか参考サイトを教えて頂けないでしょうか。 よろしくお願い致します。

  • pen123
  • お礼率58% (222/377)

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

何をされたいのかちょっとよく分からないので(^^;、 余計混乱してしまうかもしれませんが、以下の視点を持つと、理解が進むと思います。 ・Setでいちいちオブジェクトに代入しなくてもコピペ(というか値を書き写す)できます。 ・通常のマウス操作であるコピーしてペーストするというのを忘れて下さい。 ■セルのコピー 左辺の値を右辺にすると書きます。 Range("○○").value = Range("●●").value (今アクティブなシートの)セル○○の値をセル●●の値にします。 シートを指定する場合はRangeの前にSheets("●●").のように。 ブックを指定する場合はSheetsの前にWorkbooks("●●").のように書きます。 ■シートのコピー これはそういう命令です。 Sheets("○○").copy のあとにBeforeかAfterと書いて、 どのシートの前(後ろ)にコピーするか指定します。 ■参考 Sub sheet_copy1() Sheets("○○").copy After:=Sheets("○○") End Sub ↑シート名○○を、シート名○○の後ろにコピーし名前は自動付加します。 Sub sheet_copy2()   Sheets("Sheet1").Range("A1").Value = Sheets("Sheet2").Range("A1").Value End Sub ↑シート名Sheet2のA1セルの値を、シート名Sheet1のA1セルにコピペします。 Sub sheet_copy3() With Workbooks.Open("1.xlsm") Workbooks("2.xlsm").Sheets("sheet1").Copy after:=.Sheets("sheet1") End With End Sub ↑ブック名2.xlsmシート名Sheet1を、ブック名1.xlsmシート名Sheet1の後ろにコピーします。  WithがSetの役割をしています。 ・Activateする、Setして代入する、と書かれている行はほぼ全て不要です。 ・Activeなシートをどうこうする というのもワケがわからなくなるので、 直接ブック名やシート名を指定するとうまく動かせる気がします。

pen123
質問者

お礼

細かくご説明いただき有難うございました。 非常に勉強になりました。 最終的に目的の動作を構築することができました。ありがとうございます。

その他の回答 (1)

  • masatsan
  • ベストアンサー率15% (179/1159)
回答No.2

Set CopyWorkSheet1 = Worksheets("シートA") CopyWorkSheet1.Copy しーとA を変数に代入。 その変数をこぴーする。=新しいシーとができる。 SET。。。で何か新しいシートができるわけではありません。

pen123
質問者

お礼

勉強になりました。ありがとうございます。

関連するQ&A

  • 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セルから指定できるようにしたいです。 宜しくお願いします。

  • 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 '1枚目シートから貼り付け先のブックを作る w0.Worksheets(1).Copy Set s = ActiveSheet '2枚目以降のデータをコピーする 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相談箱がたよりです。何卒マクロを教えて頂きたく宜しくお願い申し上げます。

  • エクセル VBA シート名を別シートにコピー

    早速の質問ですが エクセルVBAで シート名を別シートにコピーなのですが 10個のシートを順にシート名をコピー&ペーストしたいのです。 Dim aworkbook As Workbook Dim bworkbook As Workbook Set bworkbook = ActiveWorkbook Workbooks.Add Set aworkbook = ActiveWorkbook for i=1 to 10 bworkbook.Activate Worksheets(i).Select Application.CutCopyMode = False aworkbook.Activate Worksheets(i).Select ここに入る文章がわかりません Range("A1").Select next と以上な感じで作ってみたのですが どう貼り付けして良いかわからない状況です nextでまわす以上変数でなければだめなんでしょうけれども 構文が思いつきません。 皆様よろしくお願いいたします。

  • Excel2000で、特定のシートを新規ブックに保存したい

    マクロ実行中のブックの特定のシートを新規ブックに保存したいのです。 特定のシートは、任意で複数枚あるとします。 但し、クリップボードや、Activeメソッド、Selectメソッドなど、 マクロ実行中に、Windowsの他のアプリケーションに 影響の出る恐れがあるロジックは使用しないとします。 また、特定のシートには、罫線や色の設定なども してあり、新規ブックに書式も保存します。 以下のコードは、クリップボードを経由せず、セルをコピーしています。 Sub a() Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Set xlsApp = CreateObject("Excel.Application") Set xlsBook = Workbooks.Add  '★1 Set xlsSheet = xlsBook.Worksheets(1) '★2 ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _ Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200") xlsBook.Close xlsApp.Quit Set xlsApp = Nothing Set xlsBook = Nothing Set xlsSheet = Nothing End Sub このコードは、ちゃんと動きます。 しかし、問題があります。 xlsApp.ScreenUpdating = False xlsApp.Visible = False など上記のコードに追加すると、新規ブックの操作できません。 ★1の部分で、 Set xlsBook = Workbooks.Add  としているからです Set xlsBook = xksApp.Workbooks.Add  とすると、 xlsApp.ScreenUpdating = False xlsApp.Visible = False など、新規ブックの操作ができます。 しかし、 Set xlsBook = xksApp.Workbooks.Add  では ★2の ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _ Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200") で、「RangeクラスのCopyメソッドが失敗しました。」 とエラーが発生します。 何か良い方法はありますか?

  • VBAで複数シートをまとめたい

    VBAを作るのは今回が初めてで行き詰ってしまいました。 フォルダ内の「.xlsx」4つのファイルのSheet1(4つともSheet1です) を統合.xLsmの1月シートのb2~値でコーピー貼り付けを行いたいのですが、 下記のものでやっていけば出来のかなと思ってますが、ご教授お願い致します。 Private Sub CommandButton1_Click() Dim sFile As String Dim sWB As Workbook, dWB As Workbook Dim dSheetCount As Long Dim i As Long Dim c As Long Dim ws As Worksheet Debug.Print (ws.Index) Const SOURCE_DIR As String = "C:\Users\KWEUSER\Desktop\data\" Application.ScreenUpdating = False '指定したフォルダ内にあるブックのファイル名を取得 For c = 1 To 4 sFile = Dir(SOURCE_DIR & "*.xlsx") 'フォルダ内にブックがなければ終了 If sFile = "" Then Exit Sub '集約用ブックを作成 Set dWB = Workbooks.Add '集約用ブック作成時のシート数を取得 dSheetCount = dWB.Worksheets.Count Do 'コピー元のブックを開く Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile) 'コピー元の c (1,2,3,4,5)シートを集約用ブックにコピー sWB.Worksheets(c).Copy After:=dWB.Worksheets(dSheetCount) 'シート名をファイル名に ActiveSheet.Name = sFile 'コピー元ファイルを閉じる sWB.Close '次のブックのファイル名を取得 sFile = Dir() Loop While sFile <> "" '集約用ブック作成時にあったシートを削除 Application.DisplayAlerts = False For i = dSheetCount To 1 Step -1 dWB.Worksheets(i).Delete Next i Application.DisplayAlerts = True '集約用ブックを保存して閉じる dWB.SaveAs Filename:="C:\Users\KWEUSER\Desktop\data\" & c & ".xlsx" dWB.Close Next Application.ScreenUpdating = False End Sub

  • 複数のシートを別ブックにコピーして保存したい

    毎回、シート数が変動するEXCELファイルの、表示されているシートのみ(非表示シート有)を、 別のブックにコピーして、セルの書式と値を貼付けし、 元ファイルのシート名と同じシート名を付けたいのですが、 どんなVBAを組めば良いでしょうか? 下記の様に作成してみましたが、ファイル自体がコピペされてしまう様で、 自分のイメージした通りに動きません・・・。 ご教授の程、宜しくお願いいたします。 Sub データ書き出し() Dim ws As Worksheet Dim i As Long With ActiveWorkbook i = Worksheets.Count For j = 1 To i ThisWorkbook.Worksheets(j).Cells.Copy .Worksheets(j).Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next j Application.CutCopyMode = False .SaveAs "月別DATA_" End With End Sub

  • Excel VBA 複数のオブジェクトのコピーについて

    皆様、こんにちは。 いつもお世話になっています。 ActiveSheetに、他のシートのRange("B4:AC58")をコピーしたいですが、 ActiveSheetのRange("B1")に入力された値に合わせて、Range("B4:AC58")がコピーされる回数を設定したいです。 例えば、Range("B1")に1が入力されていれば、Range("B4:AC58")を1回だけコピーする、2でしたら2回、etc. ループを作ればできそうですが、変数の設定がよくわからなくて困っています。 ループなしのものを一応、作りましたが、そこからはどうすればいいかを教えていただければ幸いです。 どうぞよろしくお願いいたします。 Dim i As Integer i = Worksheets("Sheet2").Range("B1").Value Dim MyForm As Variant Set MyForm = Worksheets("フォームtest").Range("B4:AC58") For ? Worksheets("Form").Activate MyForm.Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("B3") Next

  • VBAでシートの選択について

    初心者です。教えて下さい。 メールという名前のシートのA1のセルに入っている数字と同じ数字のシートのB1:E22までをコピーしてメールという名前のシートのB2に貼りつけたいです。 今のところ、 Dim str As string Str=Worksheets("メール用").Range("B2") Range("B1:E22").copy worksheets("メール用"),Range("B2") というところまでは入力したのですが、明らかに何か足りないというか、間違えているというか。 どなたかご教授ください。

  • シートにあるキーワードを別のシートで検索し、該当する行(複数行)を新ブックに貼り付けたい

    今週から勉強を始めたくらいのマクロ初心者なので言っている事が分かりにくかったらすみません。 エクセルVBAでマクロを組んでいるのですが、 Sheet1にあるキーワード(B3~)をSheet2の指定の列で検索し、 そのキーワードが含まれている行を新しいブックにコピーするものを作成したいです。 どうやっても検索とシートのコピーのところがうまくいかず、Sheet2の行数が2万ぐらいあるのでどの方法で検索をしたらいいのか困っています。 とりあえずブック内にシートを1つ作って、そこにヒットした行を貼り付け新しいブックにコピーすればいいのかと思いやっているのですが、動きません… 以下に現時点でのソースを記載するのでどこがまずいのか助言宜しくお願いします。 Sub kensaku() Dim key As String Dim target As String Dim x As Integer Dim y As Long Dim z As Long x = 3 y = 10 z = 1 Set sh = Worksheets.Add sh.Name = "kekka" key = Worksheets("Sheet1").Range("B" & x).Value Do Until Worksheets("Sheet1").Range("B" & x) = "" target = Worksheets("Sheet2").Range("F" & y).Value Do Until Worksheets("Sheet2").Range("F" & y) = "" If target = key Then Worksheets("Sheet2").Rows(y).Select Selection.Copy Sheets("kekka").Rows(z).Activate Activesheet.Paste z = z + 1 End If y = y + 1 Loop x = x + 1 Loop Worksheets("kekka").Copy Application.DisplayAlerts = False Worksheets("kekka").Delete Application.DisplayAlerts = True End Sub

  • 【VBA】複数のブックを1つのシートにまとめる

    あるフォルダ内に複数のブックが入っており、新しいブックに1シートでまとめようとしております。 フィルターを使用すればよいのかもしれませんが、マクロを使用したいです。 (1)全て同じフォーマットである (2)全てA17から数値が入力されているので、16行目まではフォーマットを残し、A17行目以降K列までをコピーして結合したい Sub 結合() '結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\" Const Fol As String = "C:\test\" Dim Fn Dim NewFile As Workbook Dim Wb As Workbook Dim Ws1 As Worksheet Dim R As Range Set NewFile = Workbooks.Add Set Ws1 = NewFile.Worksheets(1) Set R = Ws1.Range("A17") Fn = Dir(Fol, vbNormal) Do Until Fn = "" Set Wb = Workbooks.Open(Fol & Fn) 'ワークシート1をコピーする場合は Wb.Worksheets(1) Set Ws1 = Wb.Worksheets(1) 'タイトル行を設定 If ck = False Then For cnt = 1 To 4 Wb.Worksheets(cnt).Range("A1:J16").Copy Destination:=NewFile.Worksheets(cnt).Range("A1") Next cnt ck = True End If For cnt = 1 To 4 Set Ws1 = NewFile.Worksheets(cnt) Set Ws2 = Wb.Worksheets(cnt) R = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1 With Ws2 End With Next 'A17行目からコピーして結合する(→本当はA17行目~K列までを反映したい) Ws2.Range("A17", Ws2.Cells(Rows.Count, 3).End(xlUp)).Resize(, 20).Copy R If R.Offset(1).Value = "" Then Set R = R.Offset(1) Else Set R = R.End(xlDown).Offset(1) End If Wb.Close 'Debug.Print Fn Fn = Dir Loop Set R = Nothing Set Ws1 = Nothing: Set Ws2 = Nothing Set Wb = Nothing: Set NewFile = Nothing End Sub マクロは触ったことない初心者でグーグル検索をしながら作ってみました。 一応実行するとエラーは出ないのですが、結合されたリストが飛び飛びで、理由がわかりません。 どなたかおわかりになりますでしょうか・・・。

専門家に質問してみよう