我正在尝试将活动行从一个工作表(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
答案 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
的工作代码)