1
votes

I am trying to copy the active row from one worksheet(Sheet1) to another worksheet(Sheet3). Both the worksheets are formatted as tables starting from Row No. 14. I have the code below which will copy record from one worksheet to another. But when I copy a record from sheet 1 to Sheet 3, the first record gets coped on Row 28, the next on Row 42. I want the records to be copied from Row15 onwards(i.e. first blank from Row No 15 onwards). Please let me know.

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
can you share your workbook? because it works for me as it should.Dmitry Pavliv
@simoco can you please let me know how to share the workbook here! :)user3331363
you can use e.g. dropbox.com to upload your workbook and give us just a link:)Dmitry Pavliv

1 Answers

2
votes

This one works:

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

Here is Test workbook (working code assigned to CommandButton 2)