|
我想把20多个工作簿中的指定工作表中指定单元格("c6"、"c26"、"b3")的内容提取到另一个新建工作簿里,也就是附件里“book1"工作簿中的名为“汇总表”的工作表中,运行到er = Workbooks("book1").Worksheets("汇总表").Cells(65536, 1).End(xlUp).Row + 1这行代码时就出现“下标越界”的问题,反复检查不知问题出现在哪,同时也想就上传的代码请各位行家指点、评价一下还有哪些错误和有待改进的地方。随传有附件(附件仅选取“群众部、工程部”两个工作簿,另“book1"为提取存放数据的工作簿)
- Sub 收支总表汇总()
- 'On Error Resume Next
- Dim er As Integer
- Dim MyPath$, MyName$, Wb As Workbook, Sh As Workbook, sht As Worksheet
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- MyPath = ThisWorkbook.Path & ""
- MyName = Dir(MyPath & "*.*")
- Set Wb = ThisWorkbook
- er = Wb.Worksheets("汇总表").Range("A65536").End(xlUp).Row
- Do While MyName <> ""
- If MyName <> ThisWorkbook.Name Then
- Set Sh = GetObject(MyPath & MyName)
- For Each sht In Sh.Worksheets
- If sht.Name = "收支总表 " Then
- er = er + 1
- sht.Range("c6").Copy
- Wb.Worksheets("汇总表").Cells(er, 2).PasteSpecial Paste:=xlPasteValues
- sht.Range("c27").Copy
- Wb.Worksheets("汇总表").Cells(er, 3).PasteSpecial Paste:=xlPasteValues
- sht.Range("B3").Copy
- Wb.Worksheets("汇总表").Cells(er, 1).PasteSpecial Paste:=xlPasteValues
- End If
- Next
- Windows(MyName).Visible = True
- Workbooks(MyName).Close True '关闭工作簿
- End If
- MyName = Dir
- Loop
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
复制代码
|
|