한 워크 시트의 행 복사 (표 형식)

Question

하나의 워크 시트 (Sheet1)에서 다른 워크 시트 (Sheet3)로 활성 행을 복사하려고합니다. 두 워크 시트는 Row No. 14부터 시작하여 테이블로 포맷됩니다. 아래 워크 시트에서 다른 워크 시트로 레코드를 복사하는 코드가 있습니다. 그러나 시트 1에서 시트 3으로 레코드를 복사하면 첫 번째 레코드는 28 번 행에, 다음은 42 번 행에 복사됩니다. Row15부터 레코드를 복사해야합니다 (예 : 행 번호 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 

Answer 1

이 하나의 작품 :

여기

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