excelのマクロをつかったコピー

質問

excelのマクロを使ってもとのシートのデータをコピーして新しいブックに貼り付けを行い、ブック名を指定して保存させることを繰り返したい。

excelのマクロで以下の作業が出来ないかと考えております。

1.選択したシートのAC(i)～CW(i)をコピー (i=3,n)
2.ブック『雛形』（コピー先のテンプレートブック）を開く
3.開いたブックのSheet1のB3～BU3に値をペースト
4.同様にSheet1のB3～BU3に書式をペースト
5.ブック名を指定して保存。(ブック名は"シート名""-""i(桁指定３桁)"）
6.2～5を繰り返す。iはコピー元のデータがブランクになるまで繰り返す。

なお、コピー元のAC(i)～CW(i)はいくつかの結合セルとなっており、同シート内のB(i)～P(i)を参照して値を表示する関数を組んだデータとなっています。
作成したいブック数が3000ファイル程度になる為、手作業で行うには時間がかかりすぎるため何とか作業効率をあげたいと考えております。

操作を行ってみて記録したマクロを自分でいじってループさせられないかやっていますがうまくいきません。

Sub Macro1()

Dim i As Long
For i = 3 To 100

Sheets("Aエリア").Select
Range("AD(i):CW(i)").Select
Selection.Copy
Workbooks.Open Filename:="(雛形ファイル名）.xls"
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:BU4").Select
Range("B4").Activate
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("AZ6").Select
ファイル名 = "（新規保存ブック頭文字）"
Application.Dialogs(xlDialogSaveAs).Show (ファイル名)

Next

End Sub

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

回答No.1

nda23 · ベストアンサー

二つ欠陥があります。
(1)暗黙のオブジェクトを使っている。
(2)"AD(i)"は文字列なので範囲指定にならない。

Sub 処理()
Dim 複写元シート As WorkSheet
Dim 複写先ブック As Workbook
Dim 複写先シート As WorkSheet
Dim 行 As Long
Dim 範囲 As String
Dim 辺 As Long

Set 複写元シート = ThisWorkbook.WorkSheets("Aエリア")
行 = 2
Do
　　　　行 = 行 + 1
　　　　範囲 = "AD" & CStr(行)
　　　　If 複写元シート.Range(範囲).Value = "" Then Exit Do
　　　　範囲 = 範囲 & ":CW" & CStr(行)
　　　　Set 複写先ブック = Workbooks.Open("雛形.xls")
　　　　Set 複写先シート = 複写先ブック.WorkSheets(1)
　　　　With 複写先シート
　　　　　　　　複写元シート.Range(範囲).Copy
　　　　　　　　.Range("B3").PasteSpecial Paste:=xlPasteValues
　　　　　　　　.Range("B3").PasteSpecial Paste:=xlPasteFormats
　　　　　　　　Application.CutCopyMode = False
　　　　　　　　With .Range("B3:BU3")
　　　　　　　　　　　　For 辺 = xlEdgeLeft To xlEdgeRight
　　　　　　　　　　　　　　　　With .Borders(辺)
　　　　　　　　　　　　　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　　　　　　　　　　　End With
　　　　　　　　　　　　Next
　　　　　　　　End With
　　　　End With
　　　　複写先ブック.SaveAs "シート-" & Format(行, "0000") & ".xls"
　　　　複写先ブック..Close
Loop
End Sub

文字と変数を結合して正しい範囲指定にするには
"AD" & CStr(行) のように数値データを文字列化する関数
CStrを使って結合させます。
範囲が分かっているのにSelect→Selectionはちょっと
無駄な感じですね。
暗黙のオブジェクトを使うのはバグの元なので、必ず
どのブックのどのシートの範囲（Range）かを明示的に
書くべきです。