Sub CopySelectedFieldsInOrder()
Dim rngSource As Range ' 元データ範囲
Dim rngDest As Range ' 転記先見出しセル
'--- 範囲設定 ---
Set rngSource = Worksheets("Sales").Range("B3").CurrentRegion ' B3:F200
Set rngDest = Worksheets("Export").Range("A1:C1") ' 見出しのみ
'--- AdvancedFilter で転記 ---
rngSource.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Empty, ' 条件なしで全行対象
CopyToRange:=rngDest, _
Unique:=False ' 重複行を削除したい場合は True に変更します
MsgBox "必要列を希望順で Export シートへ転記しました。", vbInformation
End Sub
コード解説
行
説明
7–8
CurrentRegion で見出し行を含む Sales シートの表全体を取得しています。
13
CriteriaRange を省略(Empty)すると条件指定なしで全レコードが対象になります。
14
CopyToRange に転記先見出しセル範囲 A1:C1 を指定し、並び順を制御しています。
15
Unique:=False を True に変更すると、同一行を除外して転記できます。
応用ポイント
目的
実装方法
先頭にシリアル番号列を追加したい
転記後に With Worksheets("Export").Range("D2").Resize(recordNum): .Formula = "=ROW()-1": End With のように追記します。