いつも大変お世話になっております。
下記の、シートコピーのコードを書きました。
コピーシート数は、32枚~最大130枚まであります、
130枚コピーすると色々大変なのと重くなるので2分割
したいと思っているのですがシートごとに1ファイルと言うのは
検索すると出てくるのですが指定シート枚数で分割というやり方
が分かりません。
ご教示願います。
'現在アクティブなシートの後ろにコピーする Sub タイプ別シート作成() Dim TYPE1, TYPE2 Dim sh_name Dim 鋼矢板No Dim TypeNo Dim sh1, sh4 Set sh1 = Worksheets("入力シート") Set sh4 = Worksheets("作業準備") 鋼矢板No = 3 TypeNo = 3 For TypeNo = 3 To sh1.Range("A65536").End(xlUp).Row If sh1.Cells(TypeNo, 2) = sh4.Range("K10") Then '奇数No Worksheets(sh4.Range("J10") & sh4.Range("K10")).Copy After:=Worksheets(鋼矢板No + 3) 'シート名変更 sh_name = sh1.Cells(鋼矢板No, 1) ActiveSheet.Name = sh_name 'シート名にTYPE追記 ActiveSheet.Tab.ColorIndex = 4 ActiveSheet.Range("G5") = sh_name 鋼矢板No = 鋼矢板No + 1 ElseIf sh1.Cells(TypeNo, 2) = sh4.Range("K11") Then '偶数No Worksheets(sh4.Range("J11") & sh4.Range("K11")).Copy After:=Worksheets(鋼矢板No + 3) 'シート名変更 sh_name = sh1.Cells(鋼矢板No, 1) ActiveSheet.Name = sh_name '& "②" 'シート名にTYPE追記 ActiveSheet.Tab.ColorIndex = 4 ActiveSheet.Range("G5") = sh_name 鋼矢板No = 鋼矢板No + 1 End If Next MsgBox "シート作成完了しました!" End Sub
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2016/07/25 12:57