|
- Dim i As Integer, wb As Workbook, wbh As Workbook, path As String, ssname As String
- Dim imax As Integer, irow As Integer, icol As Integer
- Application.ScreenUpdating = False
- path = ThisWorkbook.path & ""
- On Error Resume Next
- Set wbh = Workbooks("汇总表.xlsx")
- If Err.Number > 0 Then
- Workbooks.Open (path & "汇总表.xlsx")
- Set wbh = ActiveWorkbook
- End If
- imax = wbh.Worksheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
- ssname = Dir(path & "*.xlsx")
- Do While ssname <> ""
- If ssname <> "汇总表.xlsx" And ssname <> "数据处理VBA.xlsm" Then
- Workbooks.Open (path & ssname)
- Set wb = ActiveWorkbook
- irow = wb.Worksheets(1).Range("a" & Rows.Count).End(xlUp).Row - 2
- icol = wb.Worksheets(1).Range("a2").End(xlToRight).Column
- wbh.Worksheets(1).Range("a" & imax).Resize(irow, icol).Value = _
- wb.Worksheets(1).Range("a3").Resize(irow, icol).Value
- imax = irow + imax
- wb.Close
- End If
- ssname = Dir
- Loop
- Application.ScreenUpdating = True
复制代码 |
|