如何将数百个工作簿的中指定数据汇总到一个新工作簿的新工作表，相隔15行。请高手指教

数百个工作簿都存放在gupiao文件夹里，路径为c:\gupiao
每本工作簿格式都一样 ：只有一张工作表，工作簿和工作表命名都相同，
将每张原工作表的a列和b列复制新工作表a列和b列，并在新工作表c列输入原工作表的名称或原工作簿的名称
在新工作表里原第一个工作簿的中指定数据与第二个工作簿的中指定数据之间相距15行
原第二个工作簿的中指定数据与第三个工作簿的中指定数据之间相距15行
原第三个工作簿的中指定数据与第四个工作簿的中指定数据之间相距15行
以此类推
原工作簿1（名称：蔬菜）
代码－名称－价格1－价格2－价格3－
11－白菜－8
21－油菜－7
35－春菜－5
原工作簿2（名称：禽类）
代码－名称－价格1－价格2－价格3－
43－公鸡－16
53－母鸡－15
98－菜鸭－17
新工作簿
11－白菜－蔬菜
21－油菜－蔬菜
35－春菜－蔬菜
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
－－－－－－－
43－公鸡－禽类
53－母鸡－禽类
98－菜鸭－禽类

在c:\gupiao下建一个“汇总百个工作簿.xls”,设计一个命令按钮，输入如下程序：
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim st As Worksheet
Dim fFile As FileSearch
Dim strTempPath As String, ViceName As String, a As String
Dim rag As Range
Dim i As Integer, k As Integer
Range("A:C").ClearContents
Application.ScreenUpdating = False
Set fFile = Application.FileSearch
k = 1
With fFile
   .LookIn = "C:\gupiao"
   If Right(fFile.LookIn, 1) = "\" Then
    a = fFile.LookIn
   Else
    a = fFile.LookIn & "\"
   End If
   .Filename = "*.xls"
   If .Execute > 0 Then
    'MsgBox ("共有" & .FoundFiles.Count & "个Excel工作簿文件")
   End If
   For i = 1 To .FoundFiles.Count
    strTempPath = .FoundFiles(i)
    If strTempPath <> ThisWorkbook.Path & "\" & ThisWorkbook.Name Then
    ViceName = Replace(strTempPath, a, "")
    Set wb = GetObject(strTempPath)
    Set st = wb.Worksheets(1)
    For Each rag In st.Range("A2:A65536")
    If rag.Value = "" Then Exit For
    Range("A" & k).Value = rag.Value
    Range("A" & k).Offset(0, 1).Value = rag.Offset(0, 1).Value
    Range("A" & k).Offset(0, 2).Value = Replace(ViceName, ".xls", "")
    k = k + 1
    Next rag
    k = k + 15
    wb.Close
    Set wb = Nothing
    End If
   Next i
End With
Application.ScreenUpdating = True
End Sub