ﾌｫﾙﾀﾞ内に3つのExcelﾌｧｲﾙのﾏｰｼﾞについて､ ?それぞれのﾌｧｲﾙは1行目ﾀｲﾄﾙ行､2行目以降はﾃﾞｰﾀが入ってます｡ ?それぞれのﾀｲﾄﾙの項目数が異なり…

ﾌｫﾙﾀﾞ内に3つのExcelﾌｧｲﾙのﾏｰｼﾞについて､
?それぞれのﾌｧｲﾙは1行目ﾀｲﾄﾙ行､2行目以降はﾃﾞｰﾀが入ってます｡
?それぞれのﾀｲﾄﾙの項目数が異なります｡
やりたいことは､それぞれのExcelﾌｧｲﾙから､予め決められたﾀｲﾄﾙ(※1)の項目値を取得し､縦に並べて(※2)1つの新しいExcelとして保存する処理をしたいです｡
※1 各ﾌｧｲﾙの共通項目をPickupし､5項目ほどのﾀｲﾄﾙ行をつけます｡ﾀｲﾄﾙ行の例は以下です｡
区分氏名年齢性別血液型備考
また､
1項目目は各ﾌｧｲﾙ名から判断し､区分という項目名を付けます｡
例：ﾌｧｲﾙ名に”関東”が含まれた場合､区分に”関東”をつける
ﾌｧｲﾙ名に”関西”が含まれた場合､区分に”関西”をつける
ﾌｧｲﾙ名に”東北”が含まれた場合､区分に”東北”をつける
※2 1行名はﾀｲﾄﾙ行2行目は各ﾌｧｲﾙを走行しﾀｲﾄﾙの項目名に当該するﾃﾞｰﾀ行を取得してｺﾋﾟｰします｡
補足：備考の項目は”関東”が含まれるﾌｧｲﾙにのみ存在する｡”関西””東北”の場合､ﾃﾞｰﾀ行をｸﾞﾚｰ色にて示します｡
Excel/VBAは不慣れでご教授いただけると嬉しいです｡よろしくお願いします｡

以下のｺｰﾄﾞを標準ﾓｼﾞｭｰﾙに貼り付けて､定数 BASE_DIR に三つのｼｰﾄがあるﾃﾞｨﾚｸﾄﾘ名をﾌﾙﾊﾟｽで設定してください｡
そして､merge_files ｻﾌﾞﾙｰﾁﾝを実行してください｡
開いているｼｰﾄに三つのﾌｧｲﾙからﾃﾞｰﾀを取り込みます｡

Const COLUMN_PATTERN = "氏名|年齢|性別|血液型|備考"
Const DIV_PATTERN = "関東|関西|東北"
Const BASE_DIR = "D:\foo\bar"

Sub merge_a_file(filename)
 Set this_book = ActiveWorkbook
 Set this_sheet = ActiveSheet

 Set ref_book = Workbooks.Open(BASE_DIR & "\" & filename)
 Set ref_sheet = ref_book.Sheets(1)  ' ひとつめのｼｰﾄ

  ' 区分をﾌｧｲﾙ名から抽出
 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = DIV_PATTERN
 Set mat = re.Execute(filename)
 If mat.Count = 0 Then
 Exit Sub
 End If
 div = mat(0)

  ' 取り込む列位置を求める
 Set col_map = CreateObject("Scripting.Dictionary")
 re.Pattern = "^(" & COLUMN_PATTERN & ")$"
 last_col = ref_sheet.Cells(1, Columns.Count).End(xlToLeft).Column
 For c = 1 To last_col
 Set mat = re.Execute(ref_sheet.Cells(1, c).Value)
 If mat.Count > 0 Then
 col_map.Add mat(0).submatches(0), c
 End If
 Next
 Set re = Nothing

 this_book.Activate
 this_sheet.Activate

  ' 参照ｼｰﾄの値を取り込む
 last_row = ref_sheet.Cells(Rows.Count, 1).End(xlUp).Row
 dest_row = Cells(Rows.Count, 1).End(xlUp).Row + 1
 cols = Split(COLUMN_PATTERN, "|")
 For r = 2 To last_row
 Cells(dest_row, 1).Value = div
 For i = 0 To UBound(cols)
 Key = cols(i)
 If col_map.exists(Key) Then
 c = col_map.Item(Key)
 Cells(dest_row, i + 2).Value = ref_sheet.Cells(r, c).Value
 End If
 Next
 dest_row = dest_row + 1
 DoEvents
 Next

 Set col_map = Nothing
 ref_book.Close
 Set ref_book = Nothing
End Sub

Sub merge_files()
  ' 取り込み対象のﾌｧｲﾙ名
 Dim filelist(3)
 filelist(1) = "data関東.xlsx"
 filelist(2) = "関西ﾘｽﾄ.xlsx"
 filelist(3) = "20160422 東北一覧.xlsx"

  ' 見出し行
 Cells(1, 1).Value = "区分"
 cols = Split(COLUMN_PATTERN, "|")
 For i = 0 To UBound(cols)
 Cells(1, i + 2).Value = cols(i)
 Next

  ' ｸﾘｱ
 Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, UBound(cols))).Clear

  ' ﾌｧｲﾙから取り込む
 For i = 1 To UBound(filelist)
 Call merge_a_file(filelist(i))
 Next

  ' ﾌｧｲﾙを保存する
 new_name = "data_" & Format(Now, "yyyymmddHHMMSS") & ".xlsm"
 ActiveWorkbook.SaveAs new_name, xlOpenXMLWorkbookMacroEnabled

End Sub

質問では条件に挙げられていなくて､前提にしていること｡

取り込む三つの Excel の一番目のｼｰﾄから取り込みます
取り込むｼｰﾄで､A列に値が入っている最後の行まで取り込みます
途中に空白行があっても､そのまま取り込みます
取り込むのは値だけです｡書式などは取り込みません
取り込みｼｰﾄに数式が書いてあっても､値として取り込みます
ﾃﾞｰﾀを取り込む前に､ｼｰﾄをｸﾘｱしています

補足：備考の項目は”関東”が含まれるﾌｧｲﾙにのみ存在する｡”関西””東北”の場合､ﾃﾞｰﾀ行をｸﾞﾚｰ色にて示します｡

備考に限らず､取り込み先のﾀｲﾄﾙ行に定数 COLUMN_PATTERN で指定した項目がなければ､取り込み開始前にｼｰﾄをｸﾘｱしているので､空白のままになります｡
｢ﾃﾞｰﾀ行をｸﾞﾚｰ色にて示します｣のところはよく分からないので､特に扱ってません｡

追記です｡

ﾌｧｲﾙを保存する処理を､上記のｺｰﾄﾞに追記しました｡
｢data_年月日時分秒.xlsm｣というﾌｧｲﾙ名で保存します｡

追記です｡

なお､2 3 4 5 6 のようなﾃﾞｰﾀが混入される

見出し行の項目の名前の一部が重複する場合に対応できるように､上記のｺｰﾄﾞを修正しました｡