|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub sczxd()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With ActiveSheet
ks = Selection.Row
js = ks + Selection.Rows.Count - 1
ar = .Range("a" & ks & ":ag" & js)
End With
ReDim br(1 To UBound(ar), 1 To 8)
For i = 1 To UBound(ar)
If Trim(ar(i, 2)) <> "" Then
n = n + 1
br(n, 1) = n
br(n, 2) = ar(i, 5)
br(n, 3) = ar(i, 14)
br(n, 4) = ar(i, 18)
br(n, 5) = ar(i, 30)
br(n, 6) = ar(i, 33)
br(n, 7) = ar(i, 2)
br(n, 8) = ar(i, 27)
End If
Next i
Sheets("装车明细").Copy
Set wb = ActiveWorkbook
With wb.Worksheets(1)
.[a6].Resize(n, UBound(br, 2)) = br
End With
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Format(Date, "yyyy-m-d") & "装车明细.xlsx"
wb.Close
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|