【マクロ】必要な項目列のデータのみ別シートに抽出する

 Sub 列抽出()

Dim データ範囲 As Range

Dim 抽出列 As Variant

Dim i As Long

Set データ範囲 = ActiveSheet.Range("A1").CurrentRegion

　抽出列 = Array(1, 3)

　Sheets.Add.Name = "抽出"

For i = 0 To UBound(抽出列)

　データ範囲.Columns(抽出列(i)).Copy Sheets("抽出").Range("A1").Offset(0, i)

Next i

End Sub

↑を改造して抽出シート値貼り付け時に下へ下へと貼り付けていく

Dim datahani, r As Range, sh1 As Worksheet

Dim harituke As Variant

Dim i As Long

Set sh1 = Worksheets("teble")

Set r = Worksheets("抽出").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

sh1.Select

Set datahani = Intersect(Range("A2").CurrentRegion, Range("A2:AH20000"))

  harituke = Array(1, 2, 8, 5, 9)

  

For i = 0 To UBound(harituke)

  datahani.Columns(harituke(i)).Copy r.Offset(0, i)

Next i