シートの部分部分を切り出しで別ファイルにする方法
EXCEL2010
シートの部分部分を切り出しで別ファイルにする方法をVBAで教えてください。
A.xlsmというファイルがあります。
これには、複数シート(aシート,bシート,cシート,dシート,eシート)が存在します。
aシートは、複数行のAセルに見出しがついています。
1行目A1FL1
18行目A1RL1
36行目A1FL2
53行目A1RL2
71行目A1FL3
88行目A1RL3
106行目A1FL4
123行目A1RL4
141行目A1FL5
158行目A1RL5
最終行は177行
という感じです。
作成したいファイルはaシートの一部とd,eを1つのファイルとし、
A1FL1.xlsx
A1RL1.xlsx
A1FL2.xlsx
A1RL2.xlsx
A1FL3.xlsx
A1RL3.xlsx
A1FL4.xlsx
A1RL4.xlsx
A1FL5.xlsx
A1RL5.xlsx
の10のファイルを作成したいのです。
A1FL1は1行~17行まで
A1RL1は18行~35行まで
A1FL2は36行~52行まで
…
A1RL5は158行~177行まで
がファイル化する範囲です。
下記は、WEBで調べた内容と学習マクロで作成したマクロです。
行の追加削除が発生すると、削除する範囲がずれてしまうので、
見出しを元に必要な範囲だけでファイル化するVBAをベタで教えていただきたく。
Sub FILE()
Const path As String = "C:¥work" '¥まで記述
Dim bk As Workbook
Set bk = ActiveWorkbook
ChDir bk.path ' ★ 保存先を bk と同じパスへ
Dim st As Worksheet
'1 A1FL1
bk.Sheets(Array("a", "d", "e")).Copy
Rows("18:177").Select
Selection.Delete Shift:=xlUp
'リンクの内容を値で固定
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveCopyAs "A1FL1.xlsx"
'18 A1RL1
bk.Sheets(Array("a", "d", "e")).Copy
Rows("36:177").Select
Selection.Delete Shift:=xlUp
Rows("1:17").Select
Selection.Delete Shift:=xlUp
'リンクの内容を値で固定
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveCopyAs "A1RL1.xlsx"
'36 A1FL2
bk.Sheets(Array("a", "d", "e")).Copy
Rows("53:177").Select
Selection.Delete Shift:=xlUp
Rows("1:35").Select
Selection.Delete Shift:=xlUp
'リンクの内容を値で固定
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveCopyAs "A1FL2.xlsx"
'53 A1RL2
bk.Sheets(Array("a", "d", "e")).Copy
Rows("71:177").Select
Selection.Delete Shift:=xlUp
Rows("1:52").Select
Selection.Delete Shift:=xlUp
'リンクの内容を値で固定
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveCopyAs "A1RL2.xlsx"
…(省略A1FL3.xlsx,A1RL3.xlsx,A1FL4.xlsx,A1RL4.xlsx,A1FL5.xlsx,A1RL5.xlsx)
って感じです。
お礼
回答ありがとうございました。 期待通りの出力ができました。ありがとうございます!