所以我有一個帶有開始、結束和提交按鈕的時間和運動研究跟蹤器。我設法開始和結束作業。
但我正在努力將特定資料復制到我的主檔案中。在我的作業簿中，我有一個狀態的下拉選擇。如果下拉串列的值為“待處理”，那么當我點擊提交按鈕時，這些案例應該在我的存檔作業簿 Sheet1 中提交，我最后一列中的狀態將是更新為已提交。因此，它將在我下次提交時排除這些情況，并且不應與主檔案中的資料重疊。
有點迷失了 If 陳述句。
希望能在大家的幫助下解決這個問題。
Sub Submit()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Prod")
Dim Outapp As Object, Logfile As String
lr As Long, Archive As Workbook
sh = ThisWorkbook.Sheets("Prod")
Dim x As Integer
Dim i As Integer
Dim lastrow As Integer
Dim r As Long, lr As Long, Archive As Workbook
r = 2
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Archive = Workbook.Open("C:\Users\ChrisLacs\Desktop\Test\Archive.xlsm")
Do Until r = lr 2
lastrow = Application.WorksheetFunction.CountBlank(sh.Range("D:D"))
For x = 2 To lastrow
If sh.Range("O" & i).Value <> "Submitted" And sh.Range("J" & i).Value = "Pending" Then
Range(Cells(r, 1), Cells(r, 3)).Copy
Archive.Worksheets("Prod").Select
erow = Archive.Worksheets("Prod").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Archive.Worksheets("Prod").Rows(erow)
Range(Cells(r, 1), Cells(r, 4)).Value = ""
End If
r = r 1
Looop
Next
End Sub
uj5u.com熱心網友回復：
試試這個：
Sub Submit()
Const WB_ARCH_PATH As String = "C:\Users\ChrisLacs\Desktop\Test\"
Const WB_ARCH_NM As String = "Archive.xlsm """
Dim wsSrc As Worksheet, r As Long, rw As Range, wbArch As Workbook
Dim wsArch As Worksheet, cDest As Range
Set wsSrc = ThisWorkbook.Sheets("Prod") 'source data sheet
'open archive workbook if not already open
On Error Resume Next 'ignore error if not open
Set wbArch = Workbooks(WB_ARCH_NM)
On Error GoTo 0 'stop ignoring errors
If wbArch Is Nothing Then Set wbArch = Workbooks.Open(WB_ARCH_PATH & WB_ARCH_NM)
Set wsArch = wbArch.Worksheets("Prod")
Set cDest = wsArch.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 'first paste destination
For r = 2 To wsSrc.Cells(Rows.Count, "A").End(xlUp).Row 'loop source rows
Set rw = wsSrc.Rows(r)
If rw.Columns("O").Value <> "Submitted" And rw.Columns("J").Value = "Pending" Then
rw.Cells(1).Resize(1, 3).Copy cDest 'Copy A:C for row `rw`
rw.Columns("O").Value = "Submitted" 'update to Submitted
Set cDest = cDest.Offset(1, 0) 'next paste destination
End If
Next r
wbArch.Close True 'save changes
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/472050.html