【最大10000ポイント】当たる!!質問投稿キャンペーン！

EXCELの複数シートをそれぞれ別ブックへ保存したい

解決済

  • 質問者：s_chikayo
  • 質問日時：
  • 回答数：3件

EXCEL97を使用しています。
1つのブック内に複数のシート（10～20枚）があります。
これを全て1シートずつの別のブックに分けて保存をするマクロを作成したいのですが、できますでしょうか？

できれば各シート内の(A4)に入力されている文字列を各ブックの名前として使用したいのですが・・・。
（各シートのセルA4の値に重複はありません）

現在は各シートを新しいブックにコピーして名前を付けて保存、の作業をシート数分繰り返しています。

すみませんがよろしくお願いいたします。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

このQ&Aに関連する最新のQ&A

「マクロ 保存」に関するQ&A： エクセルで一定時間ごとにバックアップを保存するマクロを作りたい。

A 回答 (3件)

No.3ベストアンサー

  • 回答者： tbobi
  • 回答日時：

s_chikayoさん　こんばんは。



こちらも参考にしてください。

各シートをコピーし新規ブックとして保存して閉じます。
元のブックは開いたまま残ります。
保存先を変える場合は、ChDirのカッコ内を変えてください。なお、指定したフォルダが存在しないとエラーになります。

Sub SheetCopy()

　　Dim ShtCnt As Integer, i As Integer
　　ShtCnt = ActiveWorkbook.Worksheets.Count
　　i = 1
　　'保存場所を指定
　　ChDir ("C:\TEST\")

　　Do
　　　　Sheets(i).Activate
　　　　Sheets(i).Copy
　　　　ActiveWorkbook.Close savechanges:=True _
　　　　, FileName:=ActiveSheet.Range("A4").Value & ".xls"
　　　　i = i + 1
　　Loop Until i > ShtCnt

End Sub

この回答への補足

自宅のWindows98マシンでは問題なく動きましたが、会社のNTでは保存場所の指定がうまくできませんでした。(^_^;)
保存したいフォルダにあらかじめマクロを置いておいてChDir～の行を抜いておけば支障はないので、とりあえず業務上は助かりました。

補足日時：2003/05/23 23:03
通報する
    • good
    • 0
    • 件
通報する
この回答へのお礼

お返事遅くなりましてすみません。
大変参考になりました。ありがとうございます。

通報する
お礼日時：2003/05/23 22:57

No.2

  • 回答者： VT250F
  • 回答日時：

マクロなら何でもできますよ。


試しに、録音ボタン（赤い丸印）を押して、
マクロを生成するとよろしかろう。
あとは、シート名を取得する関数などを利用して、
for - next あたりでループする。・・・
この言葉がわかるようになると、中級です。
だいたい、なんでもこなせるようになります。
わからなければ、書店でその手の本を、
立ち読みでもすれば、よろしいでしょう。
健闘を祈ります。
    • good
    • 0
    • 件
通報する
この回答へのお礼

お返事遅くなりましてすみません。
ありがとうございます。勉強します。

通報する
お礼日時：2003/05/23 22:56

No.1

  • 回答者： papayuka
  • 回答日時：

こんにちは。



対象ブックにマクロを仕込むなら、こんな感じでも良いかと。
最後に対象ブックはシート１枚だけになります。

Sub aaa()
Dim i As Integer
For i = Worksheets.Count To 2 Step -1
　Worksheets(i).Move
　ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" _
　　　　　　　　& ActiveSheet.Range("A4") & ".xls"
　ThisWorkbook.Activate
Next i
End Sub
    • good
    • 0
    • 件
通報する
この回答へのお礼

お返事遅くなりましてすみません。
大変参考になりました。ありがとうございます。

通報する
お礼日時：2003/05/23 22:55

このQ&Aに関連する人気のQ&A

「マクロ 保存」に関するQ&A： エクセルマクロで任意のファイル名をつけて保存したい

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

関連するQ&A

関連するカテゴリからQ&Aを探す

専門家回答数ランキング

専門家

※過去一週間分の回答数ランキングです。

Q質問する（無料）

他の専門家の回答をチェック

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcelのファイルからシート毎にファイルを作成する方法

複数のシートで構成されているひとつのExcelファイルからシートごとに分割してファイルを作成（保存したいです）

具体的には、

ファイル名　file.xls
　含まれているシート　Sheet1　Sheet2　Sheet3

このfile.xlsから自動でSheet1.xls　Sheet2.xls　Sheet3.xlsという
ファイルを作成してそれぞれのシートだけを保存する方法があれば教えてください。

標準の機能でなければ、フリーソフトなど別のソフトを使った方法でもかまいません。

Aベストアンサー

>シートの数が多いので、自動化マクロを作る方法を考えます。
手作業でするのが面倒と思えば、ＶＢＡでやらせるほかありません。
ーーー
ＶＢＡの経験はありますか。マクロの記録の回答に対し、反応が鈍いところ、質問も丸投げ的なことからも、経験が少ないのでは。多くの経験が必要です。
参考までに、私としては苦心したコードを挙げておきますが、判ってもらえるのかどうか。
Sub test02()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
s = wb1.Sheets.Count
MsgBox s & "枚"
For i = 1 To s
Workbooks.Add.SaveAs Filename:="AD" & i & ".xls"
wb1.Worksheets(i).Copy before:=Workbooks("AD" & i & ".xls").Worksheets(1)
Workbooks("AD" & i & ".xls").Worksheets(1).Name = "ADS" & i
Next i
End Sub
ーー
質問のファイル名　file.xlsに当たるブックの標準モジュールに上記を貼り付けます。
上記では新しく出来たブックの名前は"AD" & i & ".xls"で規定されます。適当に変えてください。
新しく出来たブックのシート名は上記では、Name = "ADS" & i
で規定されます。シートが皆同じでよければ定数だけにしてください。
以上は、シートのコピーというエクセルの良く使う機能を使ったもの（操作をＶＢＡ化したもの）です。他にもやり方があると思いますが、一番コードが短いかなと思う。

>シートの数が多いので、自動化マクロを作る方法を考えます。
手作業でするのが面倒と思えば、ＶＢＡでやらせるほかありません。
ーーー
ＶＢＡの経験はありますか。マクロの記録の回答に対し、反応が鈍いところ、質問も丸投げ的なことからも、経験が少ないのでは。多くの経験が必要です。
参考までに、私としては苦心したコードを挙げておきますが、判ってもらえるのかどうか。
Sub test02()
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
s = wb1.Sheets.Count
MsgBox s & "枚"
For i = 1 To s
Work...続きを読む

他の回答も見る

Qエクセルで各シート毎にブックに分割したい

エクセルの１つのブックに複数の名前がついたシートがあり、その各シート毎にシート名のブックに分割したいのです。
シートが少なければ手作業で分割するのですが、100枚近くのシートがあるので、できればマクロで一括処理できれば助かるのですが。
過去ログで複数のブックのシートを一つのブックにまとめる事例がありましたので、その逆もできると思うのですが。
よろしくお願いします。

Aベストアンサー

こんばんは。

こんな感じで如何でしょうか？

Sub splitBook()

Const path As String = "C:\" '\まで記述

Dim bk As Workbook
Set bk = ActiveWorkbook

Dim st As Worksheet
For Each st In bk.Sheets

Workbooks.Add
st.Copy Before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.SaveAs path & st.Name & ".xls"
ActiveWorkbook.Close

Next

End Sub

他の回答も見る

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

毎回、シート数が変動する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を組めば良いでしょうか？
下記の様に作成してみましたが、ファイル自体がコピペされてしまう様で、
自分のイメージした通りに動きません・・・。
ご教授の程、宜しくお願いいたします。

Sub データ書き出し()
Dim ws As Worksheet
Dim i As Long
With ActiveWorkbook
i = Workshe...続きを読む

Aベストアンサー

質問の文言と提示のコードには矛盾点、疑問点がありますが、
要するに以下のようなことですか？

元ブック　：　ThisWorkbook
コピー先　：　まとめ.xls

だと仮定して、、

●元ブックの表示シートを"まとめ.xls"にコピーする

●コピーするときは、"まとめ.xls”に既にコピーしてあるシートの次からコピーする
（要するに、まとめ.xlsのシートはコピーするたびに増えていくということです）

●コピーは書式と値のみにする

●コピーしたシート名は、元ブックのシート名と同じにする
（ま、これはシートをコピーすればいいわけですが）
　

もし、このようなことなら以下のコードでもできます。
　
'--------------------------------------------
Sub test()
　Dim MatomeBK As Workbook
　Dim MotoBK As Workbook
　Dim Sht As Worksheet

　Set MotoBK = ThisWorkbook
　Set MatomeBK = Workbooks("まとめ.xls")

　For Each Sht In MotoBK.Worksheets
　　　If Sht.Visible = True Then
　　　　　Sht.Copy After:=MatomeBK.Worksheets(MatomeBK.Worksheets.Count)
　　　　　ActiveSheet.Cells.Copy
　　　　　ActiveSheet.Cells(1).PasteSpecial Paste:=xlValues
　　　　　Application.CutCopyMode = False
　　　End If
　Next Sht

'●　MatomeBK.Close True 'まとめ.xls の上書き保存＆CLOSE

End Sub
'----------------------------------------------------

それから、コピー先にコピー元と同じシート名があったらどうするかなど
処理の流れを実際に即しても少し詳しく説明する必要があるでしょう。
以上です。
　
　

質問の文言と提示のコードには矛盾点、疑問点がありますが、
要するに以下のようなことですか？

元ブック　：　ThisWorkbook
コピー先　：　まとめ.xls

だと仮定して、、

●元ブックの表示シートを"まとめ.xls"にコピーする

●コピーするときは、"まとめ.xls”に既にコピーしてあるシートの次からコピーする
（要するに、まとめ.xlsのシートはコピーするたびに増えていくということです）

●コピーは書式と値のみにする

●コピーしたシート名は、元ブックのシート名と同じにする
（ま、これはシ...続きを読む

他の回答も見る

QExcel　VBAで複数シートをコピーする

Excel VBAで複数のシートを新たらしいブックにコピーする方法が分かりません。

一応、Selectで全てのシートを選択し
コピーする方法は分かるのですが
出来ればSelectなどの画面遷移をプログラム内に含ませたくありません

シートは n件存在します。
ご存知の方がおられましたら
ぜひ、教えて頂けないでしょうか？

Aベストアンサー

すいません、勉強不足でした。
ただ単純に「全てのシートを選択」し「新規ファイルにコピー」という動作であれば、
sheets.Select
sheets.Copy
だけでできました。

他の回答も見る

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

ブック内にA,Bと２つのシートがあり、ボタンをクリックすると特定の回数、シートAの情報が新規作成されたシートCにコピーされ、シートCとシートBの２シートが別ファイルとして保存される。という動きを繰り返したいのですが、
新規生成されるシート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 'とりあえず２シート作成する。
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

質問は２つあります。
(1)シートBも新規作成されたシートCと一緒に別ブックに保存したいのですが、どうすればいいでしょうか？
(2)シートのコピーの動きがイマイチよくわかりません。
今の私の環境だと（ネットで調べた書き方ですが）、シートを別ブックにコピーする際、

Set CopyWorkSheet1 = Worksheets("シートA")
CopyWorkSheet1.Copy
Set CopyWorkBook = ActiveWorkbook

となっていますが、Setで、コピー元のシートAの情報をCopyWorkSheet1にコピーしたあと、
CopyWorkSheeet1.Copy　となっていますが、この意味がわかりません。
なぜ更にコピーしているのでしょうか？またこれで、別ブックにシートが追加されてる理由もわかりません。
また、この処理の後に、 Set CopyWorkBook = ActiveWorkbook と、ブックの情報をコピーしていますが、普通に考えると最初にブックの情報をコピーして別名のブックを生成しておく必要があるように思えるのですが、後でよい理由も分かりませんし、これだと、Activeのワークブックのシート情報も全部コピーされてしまう気がするのですが。。。
この辺が全然分かっていないので、解説頂けるか参考サイトを教えて頂けないでしょうか。

よろしくお願い致します。

ブック内にA,Bと２つのシートがあり、ボタンをクリックすると特定の回数、シートAの情報が新規作成されたシートCにコピーされ、シートCとシートBの２シートが別ファイルとして保存される。という動きを繰り返したいのですが、
新規生成されるシートCだけを別ファイルで保存することまでは出来たのですが、シートBが追加できず困っています。

Sub 分割()

Dim cpy As Range
Dim pst As Range

Dim path 'ファイルパス
path = ActiveWorkbook.path
Dim CopyWorkBook
Dim CopyWorkSheet1
Dim CopyW...続きを読む

Aベストアンサー

何をされたいのかちょっとよく分からないので(^^;、
余計混乱してしまうかもしれませんが、以下の視点を持つと、理解が進むと思います。
・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なシートをどうこうする
というのもワケがわからなくなるので、
直接ブック名やシート名を指定するとうまく動かせる気がします。

何をされたいのかちょっとよく分からないので(^^;、
余計混乱してしまうかもしれませんが、以下の視点を持つと、理解が進むと思います。
・Setでいちいちオブジェクトに代入しなくてもコピペ(というか値を書き写す)できます。
・通常のマウス操作であるコピーしてペーストするというのを忘れて下さい。

■セルのコピー
左辺の値を右辺にすると書きます。
Range("○○").value = Range("●●").value
(今アクティブなシートの)セル○○の値をセル●●の値にします。

シートを指定する場合はRangeの前にSheets("●●").のよう...続きを読む

他の回答も見る

Q複数の同じフォーマットのファイルを新しいブックで一つのシートにまとめる方法

仕事で、各部署から送られてきた、同じフォーマットのファイル（シート1にのみデータ有）が50個近くあります。
それを新しいブックで一つのシートにまとめなくてはいけません。
地道にコピペするのは時間がかかるのでマクロで処理を行いたいと思います。
マクロでの処理方法ご存知の方、処理方法の載っているサイトをご存知の方、もしくはマクロより簡単な方法がありましたら教えてください。

あと、逆に一つのシートをいくつかのファイルに振り分けていく方法もご存知でしたら教えて下さい。
よろしくお願いします。

Aベストアンサー

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
で試してみてください。使い方などは
http://oshiete1.goo.ne.jp/qa4225063.html
を参照してみてください。同じ質問があったので気がつきました。

すみません。質問を勘違いしていました。
>新しいブックで一つのシートにまとめなくてはいけません
でしたね。
Sub Sample1()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf
Sheets("Sheet1").Range("A1:J1000").Copy
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Workbooks(buf).Activate
Application.CutCop...続きを読む

他の回答も見る

QExel VBA　別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列　　　　 B列　　　　　C列　　　　　　
商品名　　商品番号　　コード
モータ　　U-1325-L　　
ホルダ　　R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル（B列のコード）の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
　　Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列　　　　 B列　　　　　C列　　　　　　
商品名　　商品番号　　コード
モータ　　U-1325-L　　
ホルダ　　R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
　Application.ScreenUpdating = False
　Dim I As Long
　Dim xlBook
　Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
　I = 2
　Do While Range("A" & I).Value <> ""
　　ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
　　I = I + 1
　Loop
　xlBook.Close
　Application.ScreenUpdating = True
　MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
　Application.ScreenUpdating = False
　Dim I As Long
　Dim xlBook
　Set xlBook = Workbooks....続きを読む

他の回答も見る

Qエクセルの１シートを項目別に別シートへ分ける方法

エクセル2010で１シートのデータを項目別に別シートへ自動的に分割する方法で困っています。
検索するとマクロを使うと書いていますが、マクロはほとんど使ったことが無いのもあって、わかりませんでした。

シート1
A列（日付8ケタ＋商品番号6ケタ）　B列（売上額）
20130515000004　　　　　　　　　　　300
20130515000006　　　　　　　　　　　100
20130518000004　　　　　　　　　　　300
20130519000001　　　　　　　　　　　500
20130519000004　　　　　　　　　　　300
・・・　　　　　　　　　　　　　　　　　　　・・・
をＡ列の日付部分上8ケタを使って日別にシートを分け、
シート名をuriage20130515(uriageと日付8ケタ)という名前にしシート名＋ＣＳＶ形式で保存したいです。

シート２　シート名：uriage20130515
A列　　　　　　　　　B列
20130515000004　300
20130515000006　100

シート３　シート名：uriage20130518
A列　　　　　　　　　B列
20130518000004　300

シート４　シート名：uriage20130519
A列　　　　　　　　　B列
20130519000001　500
20130519000004　300

このように自動で別シートに分割した上で、シート名ＣＳＶ形式で保存まで自動でできるとありがたいです。

自動化できるならシートを分割するマクロ、シート名でＣＳＶ保存するマクロが一つのマクロになっていても、分かれていてもＯＫです。

このようなことはできますか？

よろしくお願いします。

エクセル2010で１シートのデータを項目別に別シートへ自動的に分割する方法で困っています。
検索するとマクロを使うと書いていますが、マクロはほとんど使ったことが無いのもあって、わかりませんでした。

シート1
A列（日付8ケタ＋商品番号6ケタ）　B列（売上額）
20130515000004　　　　　　　　　　　300
20130515000006　　　　　　　　　　　100
20130518000004　　　　　　　　　　　300
20130519000001　　　　　　　　　　　500
20130519000004　　　　　　　　　　　300
・・・　　　　　　　　　　　...続きを読む

Aベストアンサー

手順：
元データのブックを一度保存して開き直す
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string
　dim h as range
　dim s as string
　dim w as worksheet

　mypath = thisworkbook.path & "\"
　on error resume next
　kill mypath & "*.csv"
　application.displayalerts = false
　for each w in worksheets
　　if w.name <> activesheet.name then w.delete
　next
　application.displayalerts = true
　on error goto errhandle

　for each h in range("A1:A" & range("A65536").end(xlup).row)
　if isnumeric(h.value) then
　　s = left(h.value, 8)

　’ＣＳＶに書き出し
　　open mypath & "uriage" & s & ".csv" for append as #1
　　print #1, h.value & "," & h.offset(0,1).value
　　close #1

　’シートに書き出し
　　h.entirerow.copy worksheets(s).range("A65536").end(xlup).offset(1)

　end if
　next

　for each w in worksheets
　　w.columns("A:B").autofit
　next
　exit sub

errhandle:
　worksheets.add after:=worksheets(worksheets.count)
　activesheet.name = s
　range("A1:B1") = array("date", "value")
　resume
end sub


ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８を押しマクロを実行すると，ＣＳＶを書き出す。



＃「ＣＳＶを書き出す」のが目的で「別シートに振り分ける」こと自体に目的はないと思いましたが，まぁご相談なのでシートに書き出しも追加しました。。。と思って書き足してったら無駄に長いマクロになっちゃいました。あんまりイミなかったです。

手順：
元データのブックを一度保存して開き直す
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string
　dim h as range
　dim s as string
　dim w as worksheet

　mypath = thisworkbook.path & "\"
　on error resume next
　kill mypath & "*.csv"
　application.displayalerts = false
　for each w in worksheets
　　if w.name <> activesheet.name then w.delete
　next
　a...続きを読む

他の回答も見る

Qエクセルで多数のシートをまとめる方法

エクセルで10以上あるシートを一発でひとつにまとめる方法はあるでしょうか？

コピー＆ペーストを繰り返すしかないのでしょうか…

仕事で明日やらなければならないので、
お分かりになる方、是非教えてください！

Aベストアンサー

まぁ既出回答にもあるように，１０数回程度コピー貼り付けすることで，どうという作業ではないとは思います。

さておき。
ご利用のエクセルのバージョンが不明ですが，ご利用のOfficeのバージョンによっては

１．ワードを起動する
２．挿入のファイルからエクセルブックを指定する
３．添付図のようなダイアログが表示されたらラッキー成功です，ブック全体を指定して挿入する
４．Ctrl+Aで全体を選び，コピーして，エクセルの新しいシートに貼り付ける

と一発でできます。
添付図のようにならなかったときは，出来ません。

他の回答も見る

Qエクセル　シートをブックに分ける方法

エクセル2003を使用しています。

ひとつのブックに、シートＡ、Ｂ、Ｃ　とある場合、
それを、シートＡだけのブック（ファイル）、
シートＢのファイル、シートＣのファイル
というように、一気にファイルに分けることは可能でしょうか？

できれば、ファイル名＝シート名で、設定できるとうれしいです。

可能でしたら、方法を教えてください。

よろしくお願いいたします。

Aベストアンサー

そういう方法はありませんが，まぁ次のようにするとできます。

手順：
ブックを保存しておき，閉じて開き直す
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
dim s as worksheet
for each s in worksheets
s.copy
activeworkbook.saveas s.name
activeworkbook.close false
next
end sub

ファイルメニューから終了してエクセルに戻る
ALT+F8を押し，いま登録したマクロ１を実行する。

他の回答も見る
ページトップページトップ

Q質問する（無料）

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報