Excel VBAでシートを別なBookにするには？

質問

Book ABC.xls の　Sheet("TEST") を書式と値（数式でなく）だけコピーし別なBookとして保存したいのです。
その際、Sheets("LOGIC").Range("A1")を、マクロで1回目は2、2回目は3とし、12回目の13まで行います。Sheets("TEST")はSheets("LOGIC").Range("A1")を参照しているので、その結果として、Sheets("TEST")の値は当然12通りに変化します。
新たに自動作成される別なBookは　Sheet1～Sheet12の12枚のシートをもち、それぞれがABC.xls の　Sheets("TEST") の12通りのコピーとなるようにしたいのです。
このようなマクロはどう作ればいいのでしょうか？
お手上げです。何卒よろしくお願いします。

回答No.1

papayuka · ベストアンサー

こんにちは。
こんな感じでしょうか？

Sub Test()
Dim wb As Workbook , wsCount As Integer
Application.ScreenUpdating = 0
wsCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 12
Set wb = Workbooks.Add
Application.SheetsInNewWorkbook = wsCount
　With ThisWorkbook.Worksheets("LOGIC")
　　For i = 1 To 12
　　　.Range("A1").Value = i + 1
　　　ThisWorkbook.Worksheets("TEST").Cells.Copy
　　　wb.Worksheets(i).Cells.PasteSpecial Paste:=xlValues
　　　wb.Worksheets(i).Cells.PasteSpecial Paste:=xlFormats
　　Next i
　End With
Application.CutCopyMode = 0
End Sub

お礼

朝早くからご回答ありがとうございました。
おかげでなんとか思った物が作れました！ほんとうに助かりました。
ところで、昨夜一つ書き漏れがあったことに気づきました。
新しいbookの12枚のシートはすべて「値」が入っているわけですが、全部のシートのAF38のセルだけには数式を入れなければならなかったのです。
数式は非常に長く、以下の通りです。

=TEXT(IF(AF23="",0,SUBSTITUTE(AF23," ",""))+IF(AF24="",0,SUBSTITUTE(AF24," ",""))+IF(AF25="",0,SUBSTITUTE(AF25," ",""))+IF(AF26="",0,SUBSTITUTE(AF26," ",""))+IF(AF27="",0,SUBSTITUTE(AF27," ",""))+IF(AF28="",0,SUBSTITUTE(AF28," ",""))+IF(AF29="",0,SUBSTITUTE(AF29," ",""))+IF(AF30="",0,SUBSTITUTE(AF30," ",""))+IF(AF31="",0,SUBSTITUTE(AF31," ",""))+IF(AF32="",0,SUBSTITUTE(AF32," ",""))+IF(AF33="",0,SUBSTITUTE(AF33," ",""))+IF(AF34="",0,SUBSTITUTE(AF34," ",""))+IF(AF35="",0,SUBSTITUTE(AF35," ",""))+IF(AF36="",0,SUBSTITUTE(AF36," ",""))+IF(AF37="",0,SUBSTITUTE(AF37," ","")),"# # # # # # #")

どのように教えていただいたマクロに書き加えればいいでしょうか？
また、この数式自体も簡略化する方法がもしあれば教えてください。

回答No.4

papayuka

再びこんにちは。

wb.Worksheets(i).Cells.PasteSpecial Paste:=xlFormats の下に
下記の(1)か(2)のどちらかを加えれば良いと思います。

'(1)　TEST シートのもと数式をコピー
ThisWorkbook.Worksheets("TEST").Range("AF38").Copy _
　Destination:=wb.Worksheets(i).Range("AF38")

'(2)　多分同じ値が返ると思う配列数式
wb.Worksheets(i).Range("AF38").FormulaArray = _
　"=TEXT(SUM(IF(AF23:AF37="""",0,SUBSTITUTE(AF23:AF37,"" "",""""))*" & _
　"(IF(AF23:AF37<>"""",1,0))),""# # # # # # #"")"

お礼

うーん！凄い！！凄すぎる！！！！
完璧です。ありがとうございました。

回答No.3

losedog

Sheetが、左から右へ並ぶようにこだわってみました。

Sub ABC_TEST_COPY()
Dim NEWWORKBOOK As Workbook
Dim LOGICCELL As Range
Dim TESTCELL As Range
Dim LOOPCOUNT As Integer

'新規ブック作成及びSheet1からSheet12を作成
Set NEWWORKBOOK = Workbooks.Add
Do While NEWWORKBOOK.Worksheets.Count < 12
NEWWORKBOOK.Worksheets.Add
Loop
For LOOPCOUNT = 2 To 12
NEWWORKBOOK.Worksheets("Sheet" & LOOPCOUNT).Move after:= _
NEWWORKBOOK.Worksheets("Sheet" & LOOPCOUNT - 1)
Next LOOPCOUNT

'コピー処理
Set LOGICCELL = Workbooks("ABC.XLS").Worksheets("LOGIC").Cells(1, 1)
Set TESTCELL = Workbooks("ABC.XLS").Worksheets("TEST").Cells
For LOOPCOUNT = 1 To 12 Step 1
'Sheets("LOGIC").Range("A1")に値を入力
LOGICCELL.Value = LOOPCOUNT + 1
TESTCELL.Copy
'書式貼付
NEWWORKBOOK.Worksheets("Sheet" & LOOPCOUNT).Cells.PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'値貼付
NEWWORKBOOK.Worksheets("Sheet" & LOOPCOUNT).Cells.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next LOOPCOUNT

MsgBox ("END")
End Sub

お礼

ありがとうございました。いろいろな方法があるんですね。
勉強させていただきます。

回答No.2

imogasi

ロジックは、ブックABC.xlsを読み込んで、その中の１つのシートTESTをコピーし、コピー先シートの名を設定し、Ａ１だけ変化させ、別ブック名で保存しました。私のテストのため勝手ながら
ABC.xls－－－＞c:\my documents\aa1.xls"
12枚------>4枚
新ブック名----->aa11.xlsになっています。
変更してください。
（ABC.xlsのTEST以外のシートも新ブックに残りますが、あるのかどうか不明ですし、手を打っていません。）
Sub test01()
Workbooks.Open "c:\my documents\aa1.xls"
For i = 1 To 3
sn = "LOGIC" & Trim(Str(i + 1))
MsgBox sn
Workbooks("aa1.xls").Sheets.Add.Name = sn
Worksheets("TEST").Cells.Copy
Sheets(sn).Cells.Select
ActiveSheet.Paste
Sheets(sn).Range("a1") = i + 1
Next i
Worksheets("TEST").Name = "LOGIC1"
ActiveWorkbook.SaveAs "c:\my documents\aa11.xls"
End Sub
－－－－－－－－－
＞Sheets("LOGIC").Range("A1")を・・・
LOGICが突然出てきて戸惑いました。新ブックの
シート名の１つですよね。
＞Sheets("TEST")の値は当然12通りに変化します。
どの様に変化させるか、不明ですから番号数を１ずつ
アップしておきました。適当なプログラムステップで
置換えてください。

お礼

ありがとうございました。
勉強させていただきます。