彭希仁老师好: Sub 同路径工作薄合并成工作薄() Dim lj, dirname, nm, s, d1 Dim i As Long, c1 As Long Dim IsSheetEmpty lj = ActiveWorkbook.Path nm = ActiveWorkbook.Name Set d1 = CreateObject("Scripting.Dictionary") For i = 1 To Sheets.Count s = d1(Sheets(i).Name) Next i For i = 0 To ListBox2.ListCount - 1 Workbooks.Open FileName:=TextBox3.Text & "\" & ListBox2.List(i) For j = 1 To Sheets.Count '读当前工作薄中的所有的工作表 Workbooks(ListBox2.List(i)).Activate If IsSheetEmpty = IsEmpty(Sheets(j).UsedRange) Then '空表不复制 If CheckBox6.Value Then Sheets(j).Rows.EntireRow.Hidden = 0 '去隐 If d1.Exists(Sheets(j).Name) And CheckBox3.Value = True Then If IsSheetEmpty = IsEmpty(Workbooks(nm).Sheets(Sheets(j).Name).UsedRange) Then For jj = 1 To Workbooks(nm).Sheets(Sheets(j).Name).UsedRange.Columns.Count + Workbooks(nm).Sheets(Sheets(j).Name).UsedRange.Column - 1 '最后一行 If c1 < Workbooks(nm).Sheets(Sheets(j).Name).Cells(row1, jj).End(xlUp).Row Then c1 = Workbooks(nm).Sheets(Sheets(j).Name).Cells(row1, jj).End(xlUp).Row Next jj c2 = Sheets(j).UsedRange.Rows.Count + Sheets(j).UsedRange.Row - 1 Sheets(j).Rows(ComboBox1.Text + 1 & ":" & c2).Copy Workbooks(nm).Sheets(Sheets(j).Name).Cells(c1 + 1 - ComboBox2.Text, 1) Else Sheets(j).Cells.Copy Workbooks(nm).Sheets(Sheets(j).Name).Cells(1, 1) End If Else s = d1(Sheets(j).Name) Sheets(j).Copy before:=Workbooks(nm).Sheets(1) '不为空的工作表进行合并 End If If CheckBox4.Value Then Workbooks(nm).Sheets(Sheets(j).Name).UsedRange.Value = Workbooks(nm).Sheets(Sheets(j).Name).UsedRange.Value If CheckBox1.Value = True Then Workbooks(nm).Sheets(Sheets(j).Name).UsedRange.ClearFormats End If Next j Workbooks(ListBox2.List(i)).Close False Next i End Sub 我想将上面代码做成加载宏,可是运行代码确不成功,在“常用工具5.2版”中运行确正确,这是为什么?上面代码能做成“合并工作簿”加载宏吗?
[此贴子已经被作者于2008-9-25 19:34:41编辑过] |