我试图编写一些VBA,它将从列表中复制已完成的任务并将它们移动到同一工作簿中的另一个工作表,但我的代码一直给我循环而没有Do错误,即使它似乎我同时拥有。以下是我到目前为止的情况:
Sub RemoveOld()
'define varibles
Dim x As Long
Dim v As Variant, r As Range, rWhere As Range
'set starting point at row 3
x = 3
'defines the sheet the data is being coppied from and pasted to
Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("Front Page")
Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("History of Tasks")
'says to run the script as long as column H is not blank
Do While Range("H" & x).Value <> ""
'Checks if the satus is complete or submitted
If Range("H" & x).Value = "Completed" Then
'selects the next row where the 1st column is empty
lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
'pastes the data from the specified cells into the next empty row
destSheet.Range("A" & lMaxRows + 1).Value = sourceSheet.Range("B" & x).Value
destSheet.Range("B" & lMaxRows + 1).Value = sourceSheet.Range("C" & x).Value
destSheet.Range("C" & lMaxRows + 1).Value = sourceSheet.Range("D" & x).Value
destSheet.Range("D" & lMaxRows + 1).Value = sourceSheet.Range("E" & x).Value
destSheet.Range("E" & lMaxRows + 1).Value = sourceSheet.Range("F" & x).Value
destSheet.Range("F" & lMaxRows + 1).Value = sourceSheet.Range("G" & x).Value
destSheet.Range("G" & lMaxRows + 1).Value = sourceSheet.Range("H" & x).Value
'Moves the program down to the next line
x = x + 1
Else
'Checks if the satus is complete or submitted
If Range("H" & x).Value = "Uploaded" Then
'selects the next row where the 1st column is empty
lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
'pastes the data from the specified cells into the next empty row
destSheet.Range("A" & lMaxRows + 1).Value = sourceSheet.Range("B" & x).Value
destSheet.Range("B" & lMaxRows + 1).Value = sourceSheet.Range("C" & x).Value
destSheet.Range("C" & lMaxRows + 1).Value = sourceSheet.Range("D" & x).Value
destSheet.Range("D" & lMaxRows + 1).Value = sourceSheet.Range("E" & x).Value
destSheet.Range("E" & lMaxRows + 1).Value = sourceSheet.Range("F" & x).Value
destSheet.Range("F" & lMaxRows + 1).Value = sourceSheet.Range("G" & x).Value
destSheet.Range("G" & lMaxRows + 1).Value = sourceSheet.Range("H" & x).Value
'Moves the program down to the next line
x = x + 1
Else
x = x + 1
End If
Loop
End Sub
然后在我开始工作后,我希望它通过广告删除我刚刚复制的行,但同时我只是想让复制功能起作用。
非常感谢任何帮助
这是表格的样子: