Option Explicit

Sub データ取込()
    Dim Nengetu As Long
    Dim FName As String
    Dim DataBk As Workbook
    Dim LastRow As Long
    Dim LR As Long, i As Long
    Dim myCriteria As Range, myCopyTo As Range
    Dim Kakunin As Boolean

    '初回の取り込みで、ピボットを作る必要があるかどうかを確認
    If Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
        Kakunin = True
    End If

    '抽出条件範囲を変数に入れる
    Set myCriteria = Worksheets("条件").Range("A1:A2")
    '抽出先の項目範囲を変数に入れる
    Set myCopyTo = Worksheets("取込用").Range("A1:E1")

    '項目行を残して前回データをクリア（ないはずだけど、一応。テストもあるので。）
    Worksheets("取込用").Range("A1").CurrentRegion.Offset(1).Clear

    '対象年月取得
    Nengetu = Application.InputBox _
            (prompt:="対象年月西暦を 6桁の数字で 201403 のように入力してください。" _
	    , Title:="対象年月は？", Type:=1)
    If Nengetu = 0 Then
        Exit Sub
    End If

    'CSVファイル名を変数に取得
    FName = Dir(ThisWorkbook.Path & "\CSV保存用\" & Nengetu & "Data.CSV")

    'ファイルの存在を確認
    If FName = "" Then
        MsgBox "取り込みファイルの準備がまだのようです。" & vbCrLf & "確認してください。"
        Exit Sub
    End If

    '既に取りこんでいないかどうかを確認
    With Worksheets("取込ファイル名")
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To LR
            If .Cells(i, 1).Value = FName Then
                MsgBox "そのファイルは取り込み済です。"
                Exit Sub
            End If
        Next i
        'ここに来るのはまだ取りこんでない場合なので、ファイル名を入力
        .Cells(LR + 1, 1).Value = FName
    End With

    Application.ScreenUpdating = False

    'CSVファイルをExcelブックとして開く
    Workbooks.Open Filename:=ThisWorkbook.Path & "\CSV保存用\" & FName
    Set DataBk = ActiveWorkbook

    'テスト用を除いたデータを取得

    'フィルタオプションで抽出
    DataBk.Worksheets(1).Range("A1").CurrentRegion.AdvancedFilter _
         Action:=xlFilterCopy, CriteriaRange:=myCriteria, CopyToRange:=myCopyTo, Unique:=False

    'CSVファイルを閉じる
    DataBk.Close SaveChanges:=False

    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'データシートに項目行を除いて追加
        Worksheets("取込用").Range("A1").CurrentRegion.Offset(1).Copy Destination:=.Cells(LastRow + 1, 1)
        'データ範囲に名前を付ける（ピボットのデータソース）
        .Range("A1").CurrentRegion.Name = "集計用データ"
    End With

    '項目行を残して取込用データをクリア
    Worksheets("取込用").Range("A1").CurrentRegion.Offset(1).Clear

    Application.ScreenUpdating = True

    If Kakunin = True Then
        '初回の取り込みならピボットテーブルを作成してねとメッセージを。（余裕があればVBAにしてもいいですが。）
        MsgBox Nengetu & "のデータを取り込みました。" & vbCrLf & "「集計用データ」をデータソースにして" _
        　　　　　　　　　　　　　　　　　　　　　　　　　& vbCrLf & "ピボットテーブルを作成してください。"
    Else
        'ピボットを更新（初回以降ピボットテーブルが無くてもエラーにはなりません。）
        '複数のピボットテーブルがあっても、これで一度に更新できます。
        ThisWorkbook.RefreshAll
        '取り込んだよのメッセージを。
        MsgBox Nengetu & "のデータを取り込みました。"
    End If

'    '上書き保存
'    ThisWorkbook.Save
'
'    Worksheets("ピボット").Select
End Sub

    'CSVファイルをExcelブックとして開く
    Workbooks.Open Filename:=ThisWorkbook.Path & "\CSV保存用\" & FName
    Set DataBk = ActiveWorkbook

    'フィルタオプションで抽出
    DataBk.Worksheets(1).Range("A1").CurrentRegion.AdvancedFilter _
         Action:=xlFilterCopy, CriteriaRange:=myCriteria, _
                   CopyToRange:=Worksheets("取込用").Range("A1:E1"), Unique:=False

    'CSVファイルを閉じる
    DataBk.Close SaveChanges:=False

    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'データシートに項目行を除いて追加
        Worksheets("取込用").Range("A1").CurrentRegion.Offset(1).Copy Destination:=.Cells(LastRow + 1, 1)
        'データ範囲に名前を付ける（ピボットのデータソース）
        .Range("A1").CurrentRegion.Name = "集計用データ"
    End With

    '項目行を残して取込用データをクリア
    Worksheets("取込用").Range("A1").CurrentRegion.Offset(1).Clear