数据合库程序
2008-04-21 13:22:31| 分类:
VB和VBA知识
| 标签:
|举报
|字号大中小 订阅
Dim a(228), b, c1, d, e
Sub 合库()
'
' 合库 Macro
' hp 记录的宏 2008-4-21
'
'
For i = 1 To 55
a(i) = Sheets("sum").Cells(i, 1)
Next
For i = 1 To 55
b = 0
Sheets(a(i)).Select
For k = 1 To 3000
If Sheets(a(i)).Cells(k, 1) <> "" Then
b = b + 1
End If
Sheets("sum").Cells(i, 2) = b - 1
Next
Next
For i = 1 To 55
d = Sheets("sum").Cells(i, 2)
If d = 0 Then
Else
Sheets("ALL").Select
S1 = "A" & 2
S2 = "I" & (d + 1)
S3 = ":"
S4 = S1 + S3 + S2
S6 = "A"
S8 = S6 + S3 + S6
S5 = WorksheetFunction.Count(Range(S8))
If S5 = 0 Then
S5 = 2
Else
S5 = (WorksheetFunction.Count(Range(S8)) + 2)
End If
S7 = S6 & S5
Sheets(a(i)).Select
Range(S4).Select
Selection.Copy
Sheets("ALL").Select
Range(S7).Select
ActiveSheet.Paste
End If
Next
End Sub
评论这张
转发至微博
转发至微博
评论