（４） マクロ・vbaを使用してシートをコピーする方法 次のマクロは、アクティブシートを左端のSheetの後に複写します。 Sub copysheet() Sheets(ActiveSheet.Name).Copy After:=Sheets(1) End Sub
Sheets(1)は、左から１番目を示しています。 このかっこ内の番号を変えると、任意のSheetの後にアクティブシートを複写できます。 また、VBAのActiveSheet.Nameを特定のシート名称へ変更し、その変更したSheetを複写できます。 ※ Workbooksオブジェクトに対してWorksheetsを使用し、同じエクセル内部の２つのブック間で複写ができます。 次のマクロは、２つのブック間でSheetをコピーでき、 アクティブなSheetを２番目に開いたエクセルブックの２番目に複写します。 Sub copy2sheet() Sheets(ActiveSheet.Name).Copy After:=Workbooks(2).WorkSheets(1) End Sub
マクロを実行する主な手順は、以下の通りです。 １）上記マクロの Sub から End Sub までを選択し、Ctrl+C (コピー)キーを押します。 ２）Alt+F11(メニュー[ツール]-[マクロ]-[VBE])キーを押し、VBE（Visual Basic Editor）を開きます。 ３）プロジェクトエクスプローラで、VBAProject(マクロを実行するブック名)を選択します。 ４）メニュー[挿入]-[標準モジュール]でコードウィンドウを開きます。 ５）Ctrl+V (貼り付け)キーによりVBAコードをペーストします。 ６）Alt+F4（メニュー[ファイル]-[終了してMicrosoft Excelへ戻る]）キーを押し、エクセルブックをアクティブにします。 ７）Alt+F8(メニュー[ツール]-[マクロ]-[マクロ])キーを押し、マクロ選択ダイアログボックスを開きます。 ８）リストより実行したいマクロ名copysheetまたはcopy2sheetを選択します。 ９）「実行」ボタンを押と、マクロが「実行」され、シートが複写されます。
Sub copy2lastcell() For Each s In Selection: Rowz = s.Row: Columnz = s.Column: Next s myRow = Selection.Cells(1, 1).Row myColumn = Selection.Cells(1, 1).Column Cells(Rowz, Columnz).Activate Set destRange = ActiveCell For Each s In Selection s.Copy If s.Row <> Rowz And s.Column <> Columnz Then ActiveSheet.Paste destRange.Cells(1).Offset(s.Row - myRow, s.Column - myColumn) End If Next s End Sub
マクロを実行する主な手順は、以下の通りです。 １）上記マクロの Sub から End Sub までを選択し、Ctrl+C (コピー)キーを押します。 ２）Alt+F11(メニュー[ツール]-[マクロ]-[VBE])キーを押し、VBE（Visual Basic Editor）を開きます。 ３）プロジェクトエクスプローラで、VBAProject(マクロを実行するブック名)を選択します。 ４）メニュー[挿入]-[標準モジュール]でコードウィンドウを開きます。 ５）Ctrl+V (貼り付け)キーによりVBAコードをペーストします。 ６）Alt+F4（メニュー[ファイル]-[終了してMicrosoft Excelへ戻る]）キーを押し、エクセルブックをアクティブにします。 ７）セル範囲をCtrlキーを押しながら選択します。 ８）最後にコピー先のセルをCtrlキーを押しながら選択します。 ９）Alt+F8(メニュー[ツール]-[マクロ]-[マクロ])キーを押し、マクロ選択ダイアログボックスを開きます。 １０）リストより実行したいマクロ名copy2lastcellを選択します。 １１）「実行」ボタンを押と、マクロが「実行」され、選択した複数のセル範囲が最後のセルを基準にコピーされます。
（２） マクロ・vbaを使用して２つ以上のセル範囲を移動する方法 次のマクロを使用し、２つ以上のセ ル範囲を同一のシート内で移動できます。 セ ル範囲は、Ctrlキーを押しながらセル範囲を選択すると、複数選択できます。 最後に、移動先の一つのセ ルをCtrlキーを押しながら選択します。 Sub cut2lastcell() For Each s In Selection: Rowz = s.Row: Columnz = s.Column: Next s myRow = Selection.Cells(1, 1).Row myColumn = Selection.Cells(1, 1).Column Cells(Rowz, Columnz).Activate Set destRange = ActiveCell For Each s In Selection s.Copy If s.Row <> Rowz And s.Column <> Columnz Then ActiveSheet.Paste destRange.Cells(1).Offset(s.Row - myRow, s.Column - myColumn) End If Next s For Each s In Selection If s.Row <> Rowz And s.Column <> Columnz Then s.Value = "" Next s destRange.Select End Sub
ポイントは、EXCELを開く順番にあります。 （１）最初に開いたEXCELファイルに次のマクロを「挿入」します。（挿入する手順の詳細は、後半のMacroの実行手順にあります。） （２）引き続いて開いたファイルのマクロ・vbaを最初に開いたファイルへコピーします。 （３）Privateモジュールは、入力してあるワークシートに含め、最初に開いたファイルの２番目以降のSheetとしてコピーします。 Sub copymacro() For Each w In Workbooks If w.Name <> Workbooks(1).Name Then For Each c In w.VBProject.VBComponents If c.Type <> 100 Then Set myModule = Workbooks(1).VBProject.VBComponents.Add(1) myModule.CodeModule.addfromstring c.CodeModule.Lines(1, c.CodeModule.CountOfLines) End If Next c For Each ws In w.Worksheets Set myModule = w.VBProject.VBComponents.Item(ws.CodeName).CodeModule If myModule.CountOfLines > 0 Then ws.Copy After:=Workbooks(1).Worksheets(1) Next ws End If Next w End Sub
注意点は、記事の前半ですでに説明しましたように、EXCELを開く順番にあります。 （１）最初に開くEXCELファイルに次のプログラムを「挿入」します。 （２）引き続いて開いたファイルのMacro・vbaを最初に開いたファイルへ移動します。 （３）Privateモジュールは、モジュールがあるワークシートに付属させ、最初に開いたファイルの２番目以降へSheetとして移動します。 Sub movemacro() For Each w In Workbooks If w.Name <> Workbooks(1).Name Then For Each ws In w.Worksheets Set myModule = w.VBProject.VBComponents.Item(ws.CodeName).CodeModule If myModule.CountOfLines > 0 Then ws.Copy After:=Workbooks(1).Worksheets(1) Next ws For Each c In w.VBProject.VBComponents If c.Type = 100 Then Line = c.CodeModule.CountOfLines If Line <> 0 Then c.CodeModule.DeleteLines 1, Line Else Set myModule = Workbooks(1).VBProject.VBComponents.Add(1) myModule.CodeModule.addfromstring c.CodeModule.Lines(1, c.CodeModule.CountOfLines) w.VBProject.VBComponents.Remove c End If Next c End If Next w End Sub
（３） フォルダー間をマクロ・vbaにより移動する方法 次のマクロを実行します。 Sub movefile2file() Dim objF As FileSystemObject Set objF = New FileSystemObject Do objF.MoveFile Cells(intL + 1, 1).Value, Cells(intL + 1, 2).Value intL = intL + 1 Loop While (Cells(intL + 1, 1).Value <> "") Set objF = Nothing End Sub
記事の前半と同様にアクティブシートのセルA1 B1から次のようにファイル名称がフォルダー名を付けて入力されている、と仮定しました。 「空白行」がデータの終わりです。 A B C:\te_st\tes_t001.xls C:\tesa2\tes_t001.xls C:\te_st\tes_t002.xls C:\tesa2\tes_t002.xls C:\te_st\tes_t003.xls C:\tesa2\tes_t003.xls C:\te_st\tes_t004.xls C:\tesa2\tes_t004.xls C:\te_st\tes_t005.xls C:\tesa2\tes_t005.xls ・・・・・・・・・ ・・・・・・・・・
