您好！能给”vb 多个excel文件依次拷贝到另一个excel的一个sheet里“的代码给看看吗？新手不懂啊！谢谢！

您好！能给”vb 多个excel文件依次拷贝到另一个excel的一个sheet里“的代码给看看吗？新手不懂啊！谢谢！

上次工作需要 我写了一个，供你参考

nhPrivate Sub Command1_Click()
Dim objDlg, objF, DstPath
Set objDlg = CreateObject("Shell.Application")
Set objF = objDlg.BrowseForFolder(&H0, "选择存放位置：", &H1)
If InStr(1, TypeName(objF), "Folder", vbTextCompare) > 0 Then
DstPath = objF.self.Path
Else
MsgBox "目录无效！"
End If
With DirPart
.Pattern = "*.xls"
.Path = DstPath
'For i = 0 To .ListCount - 1
'DirPart.AddItem (.List(i))
'Next
Text2.Text = DstPath
End With
End Sub

Private Sub Command2_Click()
CommonDialog1.Filter = "xls|*.xls"
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
End Sub

Private Sub Command3_Click()
'CommonDialog2.ShowOpen
'Text2.Text = CommonDialog2.FileName
End Sub

Private Sub Command4_Click()
' If DirPart.Path = DirTotal.Path Then
' MsgBox "为提高处理速度，请不要把总表文件和分表文件放于同一文件夹下！", _
vbOKOnly + vbExclamation, "警告"
'ElseIf FileTotal.FileName = "" Then
' MsgBox "请先在总表文件列表框内选择总表文件！", vbOKOnly + vbCritical, "错误"
'Else
Dim xlsApp As Object
Dim xlsBookTotal As Object
Dim xlsBookPart As Object
Dim xlsSheetTotal As Object
Dim xlsSheetPart As Object
Dim i As Integer
Dim j As Integer
Dim intFileCount As Integer
Dim intHead As Integer
Dim intEnd As Integer
Dim intLastRow As Long
Dim intLastRowPart As Long
Dim timeStart As Date

On Error GoTo ErrHandle
lblInfo.ForeColor = vbBlue
lblInfo.Caption = "正在汇总…"
timeStart = Now()

Set xlsApp = CreateObject("Excel.Application")
Set xlsBookTotal = xlsApp.Workbooks.Open(Text1.Text)
Set xlsSheetTotal = xlsBookTotal.Worksheets(1)

intFileCount = DirPart.ListCount

For i = 0 To intFileCount - 1
Set xlsBookPart = xlsApp.Workbooks.Open(DirPart.Path & "\" & DirPart.List(i))
Set xlsSheetPart = xlsBookTotal.Worksheets(1)
xlsheet.Range("B2:B18").Copy
xlsBookTotal.Range("A" & 1 + i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
xlsBookPart.Close
Next
xlsBookTotal.Save
xlsBookTotal.Close
lblInfo.Caption = "汇总完成！"

MsgBox "汇总完成！" & vbLf & "文件数量：" & intFileCount & vbLf & "消耗时间：" & _
Format(Now() - timeStart, "hh:mm:ss"), vbOKOnly + vbInformation, "汇总完成"
ErrHandle:
If lblInfo.Caption <> "汇总完成！" Then
lblInfo.ForeColor = vbRed
lblInfo.Caption = "操作错误！"
End If
xlsApp.Quit
Set xlsSheetTotal = Nothing
Set xlsSheetPart = Nothing
Set xlsBookTotal = Nothing
Set xlsBookPart = Nothing
Set xlsApp = Nothing
End Sub

大概思路是这样的： 建立数组，读取excel然后，计算出记录数量，将数据填充到数组里面 建立新的excel工作簿，直接将数组填充进去； 读取第二张表，照例清空数组，用新表数据填充数组，在通过数组填充到新的excel表里，记住需要制定填充的行号，就是钱一张表的记录数+1。 如此反复，就可以了。