- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2025-7-5
|
2#
發表於 2011-9-29 21:53
| 只看該作者
回復 1# yeh199200
你試看看這是不是你要的 :- Sub nn()
- Dim lCurRows As Long, lJ As Long
- Dim rData As Range
-
- Set rData = Sheets("數據").Cells(1, 1)
-
- With rData
- For lJ = 4 To 17
- If .Cells(lJ, 1) <> "" And .Cells(lJ, 3) <> "" Then
- With Sheets(CStr(.Cells(lJ, 1)))
- lCurRows = .Cells(Rows.Count, 1).End(xlUp).Row
- .Cells(lCurRows, 1).Resize(1, 10).Copy
- .Cells(lCurRows + 1, 1).PasteSpecial
- .Cells(lCurRows + 1, 1) = Date ' 今天日期
-
- rData.Parent.Cells(lJ, 3).Resize(1, 4).Copy
- .Cells(lCurRows + 1, 2).PasteSpecial Paste:=xlPasteValues
- End With
- End If
- Next lJ
- End With
- End Sub
複製代碼 |
|