Excel VBA无法使循环传输代码生效

时间:2018-04-26 17:48:48

标签: excel vba excel-vba

我试图编写一些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

然后在我开始工作后,我希望它通过广告删除我刚刚复制的行,但同时我只是想让复制功能起作用。

非常感谢任何帮助

这是表格的样子:

enter image description here

0 个答案:

没有答案