解决方案|标签导出电缆图表为Excel后的处理
Sub Combine_cable_by_caodaping()
Application.ScreenUpdating = False
Dim rng1, rng2 As Integer
'创建一个新的工作表
Worksheets(1).Copy before:=Worksheets(1)
Worksheets(1).Name = '合并后的电缆表'
'使用循环复制其它工作表中的内容
Dim I, Wscount As Integer
Dim SourceLastRow, SourceLastColumn As Integer
Dim AimlastRow As Integer
Dim Range1 As Range
Wscount = Worksheets.Count
For I = 3 To Wscount
'查找目标工作表的最后一行
AimlastRow = Worksheets(1).UsedRange.Rows.Count
AimlastRow = AimlastRow + 1 ' 上一根电缆之后向下偏移2行
'查找数据源的最后一行
Worksheets(I).Select
SourceLastRow = Worksheets(I).UsedRange.Rows.Count
SourceLastColumn = Worksheets(I).UsedRange.Columns.Count
Set Range1 = Range(Cells(4, 1), Cells(SourceLastRow, SourceLastColumn))
Range1.Copy
Worksheets(1).Cells(AimlastRow, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next I
Worksheets(1).Select
rng1 = MsgBox('恭喜你!报表合并成功!', vbOKOnly + vbInformation + vbDefaultButton1, '恭喜你')
Application.ScreenUpdating = True
End Sub
块属性: 格式 (连接) [10] <10608 10>: [20067<20201<20006,0,0,0,0,1,0,0,0,en_US,0,0,0,0,0,0,0>>]
块属性: 格式 (连接) [11] <10608 11>: [20067<117<22001,0,0,0,0,0,0,0,0,en_US,0,0,0,0,0,0,0>>]
块属性: 格式 (连接) [12] <10608 12>: [20067<20201<20011,0,0,0,0,1,0,0,0,en_US,0,0,0,0,0,0,0>>]
来源:曹大平汉化工作室
赞 (0)