Excelマクロでファイルを1つずつ選択する方法

先日こちらで、あるフォルダから10個のcsvファイルをまとめて選択し、そのデータをSheet1～10に順番に取り込むという方法を教えていただきました。
その時のものを一番最後に添付します（長くてすみません）。

これとは別に、1つずつ任意のファイルを選択して、あらかじめ用意しているシートにデータを取り込むということをしたいと思っています。
教えていただいた内容をもとに、いろいろいじっているのですが、なかなかうまくいきません。
どのようにすればいいのか、教えていただけないでしょうか。

＜やりたいこと＞
(1)デスクトップ上にあるフォルダ（フォルダ名：データ格納フォルダ）にあるcsvファイルを
選択できるダイアログボックスを表示する（ここで選択するファイルは１つ）。
(2)　(1)で選んだファイルのデータを「Sheet1」に取り込む。
(3)　「Sheet1」のセルD2～D260までのデータを、同じブックにある「計算」シートのE4～E260にコピーする。

以降、
2つ目のcsvファイルを選択→「Sheet2」に取り込み→「Sheet2」のD2～D260までのデータを「計算」シートのK4～K260のセルにコピーする

3つ目のcsvファイルを選択→「Sheet3」に取り込み→「Sheet1」のD2～D260までのデータを「計算」シートのQ4～Q260のセルにコピーする

といった感じです。
ファイルの数は10個あり、10回繰り返します。
その際、データを取り込む際のシート（sheet1～sheet10）と、コピー先のセルがずれていきます。
（コピー元のセルの位置は変わりません。もしかすると、Sheet1～10を用意しなくても1つのシートで出来るのかもしれませんが…）

分かりづらいかと思いますが、どうか教えていただけないでしょうか。
よろしくお願いいたします。

先日教えていただいた内容：
----------------------------------------------------------------
Sub データ取り込み()

Dim FileList() As Variant, tmpName As Variant
Dim i As Integer

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.InitialFileName = Environ("userProfile") & "\desktop\k-db"
.Filters.Clear
.Filters.Add "CSVファイル", "*.csv"
.Filters.Add "すべてのファイル", "*.*"
.FilterIndex = 1

If CBool(.Show) Then
'選択ファイルのパスの格納
ReDim Preserve FileList(.SelectedItems.Count - 1)
For Each tmpName In .SelectedItems
FileList(i) = tmpName
i = i + 1
Next
Else
MsgBox "選択ファイルが無いので中止しました"
Exit Sub
End If
End With

For i = LBound(FileList) To UBound(FileList)
'Debug.Print FileList(i), i
Call 取り込みSheet(FileList(i), i + 1)
Next
End Sub

Private Sub 取り込みSheet(ByVal MyFileName As String, ByVal MyFileNo As Integer)
Worksheets("data" & CStr(MyFileNo)).Select
Range("A1").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & MyFileName, Destination:=Range("$A$1"))
.Name = "cell" & CStr(MyFileNo) 'cell1～cell10 まで名前
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
------------------------------------------------------

No.1 ベストアンサー 回答者： kmetu 回答日時： 2014/02/22 23:05

Sub データ取り込み()内の

For i = LBound(FileList) To UBound(FileList)
を外して全体を10回ループ
取り込みSheet(FileList(i), i + 1)
の変数iを10回ループする変数に変更し、あとは、データのコピー部分だけを追加してやればいいだけだと思われますがダメなんでしょうか。

この回答へのお礼

早速のご回答、ありがとうございます！

ループのやり方が、いまいち分かっておらず、エラーばかりです（汗）
ループでやればすっきりするのでしょうね…。
あれこれ試作したところ、「Sub ●●()」を10個作り、何とか出来そうです。

次はこれをループにする方法を探してみたいと思います。

ありがとうございました！

お礼日時：2014/02/23 13:10