CODEWITHSUNDEEP
vbaexcel
user3331363
user3331363

Reputation: 345

Copying rows from one worksheet (formatted as table)

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

Upvotes: 1

Views: 156

Answers (1)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35853

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)

Upvotes: 2

Related Questions