列を抽出して右隣りのシートに貼り付ける
このコードは、現在のアクティブシートから指定された列を抽出し、右隣の新しいシートに貼り付けるものです。抽出する列は、Array(1, 3)に設定されており、1列目と3列目が抽出されます。
また、新しいシートには連番が付けられ、名前が “結果ﾃﾞｰﾀ_1″、”結果ﾃﾞｰﾀ_2″、”結果ﾃﾞｰﾀ_3” といったように変化していきます。
Sub 列抽出()
Dim データ範囲 As Range
Dim 抽出列 As Variant
Dim i As Long
Set データ範囲 = ActiveSheet.Range("A2").CurrentRegion
抽出列 = Array(1, 3)
Dim Num As Long '連番用の変数
On Error Resume Next
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "←列抽出"
Do
If Err.Number = 0 Then Exit Do
Err.Clear
Num = Num + 1
ActiveSheet.Name = "結果ﾃﾞｰﾀ" & "_" & Num
Loop
Set ws2 = ActiveSheet
For i = 0 To UBound(抽出列)
データ範囲.Columns(抽出列(i)).Copy ws2.Range("A1").Offset(0, i)
'データ範囲.Columns(抽出列(i)).Copy Sheets("抽出").Range("A1").Offset(0, i)
Next i
MsgBox "完了"
End Subアクティブシートから指定の列を抽出し、新しいシートに転記する手順（概要）
- 列抽出したいデータ範囲を定義する
- 抽出する列を指定する
- 新しいシートを作成し、シート名を設定する
- 抽出した列を新しいシートに転記する
アクティブシートから指定の列を抽出し、新しいシートに転記する手順（詳細）
- データ範囲をA2セルから始まる範囲として定義します。CurrentRegionプロパティを使用して、その範囲を自動的に決定します。
- 抽出したい列のインデックスを配列に格納します。ここでは、1列目と3列目を抽出するよう指定しています。
- 新しいシートを作成し、名前を「結果ﾃﾞｰﾀ_〇」という形式で設定します。〇は1から始まる連番となっています。
- 指定された列を抽出し、新しいシートのA1セルから始まる範囲に転記します。各列は、抽出列のインデックスに基づいて、新しいシート上で隣接する列に配置されます。
コメント