|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
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 |
|