|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 复制()
Dim sht As Worksheet, arr, brr, i&, j&, k&
Application.ScreenUpdating = False
ReDim brr(1 To Cells.Rows.Count, 1 To 7)
For Each sht In Worksheets
With sht
If .Name <> "汇总图书" Then
arr = .Range("A4:G" & .Cells(Rows.Count, 2).End(3).Row)
For i = 1 To UBound(arr)
k = k + 1
For j = 2 To UBound(arr, 2)
brr(k, j) = arr(i, j)
Next
brr(k, 1) = k
Next
End If
End With
Next
[A5:i8000].ClearContents
[A5].Resize(k, 7) = brr
Application.ScreenUpdating = True
End Sub |
|