excel宏在循环中复制数据,直到命中空行错误

时间:2016-06-08 16:38:06

标签: excel vba excel-vba loops macros

我正在尝试用VBA编写一个宏,它将把我的表格中的数据复制到一个平铺的“前端”到另一张名为“原始数据”的表格中。这两张表是下面的图片

enter image description here

现在我只处理上面的绿表

enter image description here

这是我到目前为止的代码,用于复制并粘贴到下一个空行中的另一个工作表中:

Sub transfer()
    Dim x As Long
'set starting point at row 8
    x = 8
    Dim BlankFound As Boolean
'defines the sheet the data is being coppied from
    Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("Front End")
'defines the sheet the data is being pasted into
    Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("Raw Data")

    Do While BlankFound = False

'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 + 2).Value = sourceSheet.range("C2").Value
 destSheet.range("M" & lMaxRows + 2).Value = sourceSheet.range("E2").Value
 destSheet.range("N" & lMaxRows + 2).Value = sourceSheet.range("E4").Value
 destSheet.range("P" & lMaxRows + 2).Value = sourceSheet.range("G4").Value
 destSheet.range("Q" & lMaxRows + 2).Value = sourceSheet.range("C4").Value
 destSheet.range("O" & lMaxRows + 2).Value = sourceSheet.range("I3").Value
 destSheet.range("B" & lMaxRows + 2).Value = sourceSheet.range("Bx").Value
 destSheet.range("L" & lMaxRows + 2).Value = sourceSheet.range("Cx").Value
 destSheet.range("F" & lMaxRows + 2).Value = sourceSheet.range("Dx").Value
 destSheet.range("G" & lMaxRows + 2).Value = sourceSheet.range("Ex").Value
 destSheet.range("I" & lMaxRows + 2).Value = sourceSheet.range("Gx").Value
 destSheet.range("K" & lMaxRows + 2).Value = sourceSheet.range("Hx").Value
 destSheet.range("H" & lMaxRows + 2).Value = sourceSheet.range("Nx").Value

        x = x + 1
        If Cells(x, "E").Value = "" Then
        BlankFound = True
        end if
    Loop
End sub

我需要将绿色表格中的每一行宏复制到“原始数据”表格中的下一个空行,直到宏点击“实际周期”,即E列,即为空。

感谢任何帮助,谢谢!

1 个答案:

答案 0 :(得分:1)

我会按照您发现下一个要粘贴的单元格的方式执行此操作。

LastRow = sourceSheet.range("E8").end(xldown).row然后

For curRow = 8 to LastRow

或者检查Do while sourcesheet.range("E" & curRow).value<>""

之类的实际空白