【VBA初心者】同じフォルダ内のcsvファイルを1つのシートに縦に並べる

エクセルVBAで、同じフォルダ内にある複数のcsvファイルの文字を
別のエクセルファイルに縦に並べて転記したいです。

非常によく似た質問があったのですが（以下URL）、こちらは2つめ以降に読み取られたcsvファイルの1行目を削除（か、そもそも読み取っていないのか、、）するような指示になっています。
http://oshiete.goo.ne.jp/qa/4884584.html


以下マクロを作動させた際にcsvの1行目の情報もすべて記載させるようにするためには、
どこをどのように修正すればよいか教えて頂きたいです。

マクロの知識は無いに等しいので、コードをそのまま記載頂きたいです。
申し訳ありませんが何卒よろしくお願いいたします。

-----------------------------------------------------------------
Private Sub try()
Dim ws As Worksheet
Dim fd As String
Dim fn As String
Dim ret As String
Dim i As Long
Dim n As Long
Dim x As Long
Dim s As Long

fd = ThisWorkbook.Path & "\"
'fd = FDSELECT 'フォルダ選択の場合

If Len(fd) = 0& Then Exit Sub
Application.ScreenUpdating = False
'ActiveWorkbookにシートを追加して処理
Set ws = Sheets.Add
On Error GoTo errHndler
fn = Dir(fd & "*.csv")

x = 1
s = 1
Do Until Len(fn) = 0&
i = i + 1
'データCountにより次のセット先変更
n = n + x
'外部データ取り込み
x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), s)
If x < 0 Then
Err.Raise Number:=1000, Description:="CSV読み込みに失敗"
ElseIf (n + x) >= Rows.Count Then
'行数overしてもエラーかからないため取り込み直し
ws.Rows(n).Resize(x).Delete
Set ws = Sheets.Add
n = 1
x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), 1&)
End If
'ファイル名をA列にセット
ws.Cells(n, 1).Resize(x).Value = fn
s = 2
fn = Dir()
Loop

If i > 0 Then
ret = i & "files.done"
Else
ret = "no file"
End If

errHndler:
If Err.Number <> 0 Then
ret = Err.Number & vbTab & Err.Description
Debug.Print ret
End If
Application.ScreenUpdating = True
MsgBox ret
Set ws = Nothing
End Sub
'---------------------------------------------------------------------
Private Function CSVQRY(ByRef ws As Worksheet, _
ByRef fs As String, _
ByRef rs As Range, _
ByVal sr As Long) As Long
Dim cnt As Long

On Error GoTo errChk
With ws.QueryTables.Add(Connection:="TEXT;" & fs, _
Destination:=rs)
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = sr
.TextFileCommaDelimiter = True
.Refresh False
cnt = .ResultRange.Rows.Count
.Parent.Names(.Name).Delete
.Delete
End With
CSVQRY = cnt
Exit Function
errChk:
CSVQRY = -1
End Function
'---------------------------------------------------------------------
Private Function FDSELECT() As String 'フォルダ選択Function
Dim obj As Object
Dim ret As String

Set obj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "SelectFolder", 0)
If obj Is Nothing Then Exit Function
On Error Resume Next
ret = obj.self.Path & "\"
If Err.Number <> 0 Then
ret = obj.Items.Item.Path & "\"
Err.Clear
End If
On Error GoTo 0
Set obj = Nothing
FDSELECT = ret
End Function

No.1 ベストアンサー 回答者： 30246kiku 回答日時： 2016/03/24 15:29

> s = 2

ここをコメントにして、どうなりますか

この回答へのお礼

こんにちは、早速のご回答ありがとうございます！！！！
教えて頂いた通り、該当箇所を外しましたら1行目から転記ができており、感動しております。

本当にありがとうございます。今後の作業がだいぶ楽になりますし、ミスも減らせます。
言葉足らずな箇所等もあったかと思いますが、ご親切に教えていただきましてありがとうございました！！！

お礼日時：2016/03/24 16:11