从一个工作表复制行(格式为表)

时间:2014-03-19 14:21:38

标签: excel vba excel-vba

我正在尝试将活动行从一个工作表(Sheet1)复制到另一个工作表(Sheet3)。两个工作表都被格式化为从第14行开始的表。我有下面的代码,它将记录从一个工作表复制到另一个工作表。但是当我将一张记录从表1复制到表3时,第一行记录在第28行处理,第二行在第42行处理。我希望从第15行开始复制记录(即第15行以后的第一个空白)。 请告诉我。

Private Sub CommandButton1_Click()
   Dim tbl As ListObject
   Dim tblRow As ListRow
   Dim lastRow As Long

   If UCase(Range("F" & ActiveCell.Row)) <> "YES" Then
       MsgBox "Value not set to 'Yes'; Record not added"
       Exit Sub
   End If

   With ThisWorkbook.Worksheets("Sheet3")

       If Not IsError(Application.Match(Range("B" & ActiveCell.Row), .Range("B:B"), 0)) Then
          Response = MsgBox("Record already exists, add again?", vbQuestion + vbYesNo + 256)
          If Response = vbNo Then Exit Sub
       End If

       Set tbl = .ListObjects(1)
       If tbl.Range(tbl.Range.Rows.Count, "B") = "" Then
          lastRow = Application.Min(tbl.Range(tbl.Range.Rows.Count, "B").End(xlUp).Row + 1, _
                          Application.Max(4, .Cells(.Rows.Count, "B").End(xlUp).Row + 1))
       Else
          lastRow = tbl.ListRows.Add.Range.Row
       End If

    End With
    tbl.Range(lastRow, "B").Resize(, 3).Value = _
         Range("B" & ActiveCell.Row).Resize(, 3).Value
    MsgBox "Record added"

End Sub

1 个答案:

答案 0 :(得分:2)

这个有效:

Private Sub CommandButton2_Click()
    Dim tbl As ListObject
    Dim lastRow As Long

    If UCase(Range("E" & ActiveCell.Row)) <> "YES" Then
        MsgBox "Value not set to 'Yes'; Record not added"
        Exit Sub
    End If
    'change Sheet3 to destination sheet - where you need to paste values
    With ThisWorkbook.Worksheets("Sheet3")
        If Not IsError(Application.Match(Range("A" & ActiveCell.Row), .Range("A:A"), 0)) Then
            If MsgBox("Audit already exists, add again?", vbQuestion + vbYesNo + 256) = vbNo Then Exit Sub
        End If

        Set tbl = .ListObjects(1)
        If tbl.Range(tbl.Range.Rows.Count, "A") = "" Then
            lastRow = tbl.Range(tbl.Range.Rows.Count, "A").End(xlUp).Row + 1
        Else
            lastRow = tbl.ListRows.Add.Range.Row
        End If
        .Range("A" & lastRow).Resize(, 6).Value = _
            Range("A" & ActiveCell.Row).Resize(, 6).Value
        MsgBox "Record added"
    End With
End Sub

以下是Test workbook(分配给CommandButton 2的工作代码)