...下所有工作表的内容,可汇总后只出现了表头,却没有数据行显示,求指点...

发布网友

我来回答

共2个回答

热心网友

Sub text()
Dim Path_str As String
Dim File_str As String
Dim Open_file As Workbook
Dim FileNamePath_str As String
Dim Open_Sheet As Worksheet
Dim Row0&, Column0&, Row1&, Column1&, Row01&
With Application.FileDialog(msoFileDialogOpen) '引用打开文件对话框
.AllowMultiSelect = True '允许多选文件
If .Show = 0 Then MsgBox "取消": Exit Sub '如果选择了取消则退出程序
ThisWorkbook.Sheets("sheet1").Cells.Clear

For i = 1 To .SelectedItems.Count '遍历所有选中的文件
FileNamePath_str = .SelectedItems(i) '获取文件全名

Path_str = Replace(FileNamePath_str, "\" & Split(FileNamePath_str, "\")(UBound(Split(FileNamePath_str, "\"))), "") '

File_str = Split(FileNamePath_str, "\")(UBound(Split(FileNamePath_str, "\")))

Set Open_file = Workbooks.Open(FileName:=FileNamePath_str)
ThisWorkbook.Activate

For Each Open_Sheet In Workbooks(File_str).Sheets
With ThisWorkbook.Sheets("sheet1")
'写入表头
If .Cells(Rows.Count, 1).End(xlUp) = "" Then
.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Resize(1, 2) = Array("工作簿名", "工作表名")
.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 3).Resize(1, 15) = Open_Sheet.[a1:n1].Value
End If
'打开的工作簿
Row1 = Open_Sheet.Range(Open_Sheet.[A1], Open_Sheet.UsedRange).Rows.Rows.Count
Column1 = Open_Sheet.Range(Open_Sheet.[A1], Open_Sheet.UsedRange).Columns.Count
Row0 = .Cells(Rows.Count, 3).End(xlUp).Row + 1 '第三列最后一行
.Cells(Row0, 3).Resize(Row1 - 1, Column1).Value = Open_Sheet.Range("A2").Resize(Row1 - 1, Column1).Value
Row01 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' 第一列最后一行
.Cells(Row01, 1).Resize(Row1 - 1, 1) = File_str
.Cells(Row01, 2).Resize(Row1 - 1, 1) = Open_Sheet.Name
End With
Next Open_Sheet
Workbooks(File_str).Close False
Next i
End With
End Sub

热心网友

我测试过是没有问题的，但我觉得表头不应该也汇总进来吧