在表格内创建新行

Question

Sub add_product()
' add_product Macro
' ADD PRODUCT MACRO
' TeachExcel.com
' Takes data from one worksheet and stores in in the next empty row on another worksheet.

Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Long

' Make some sheet variables so we can use those instead of hard-coding sheet references in the code.
Set sourceSheet = Sheets("add product")
Set dataSheet = Sheets("products")

' Get the next empty row from the Data sheet.
nextRow = dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row

' Input the form values into the Data sheet.
dataSheet.Cells(nextRow, 1).Value = sourceSheet.Range("J5").Value
dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("J7").Value
dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("J9").Value
dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("J11").Value
dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("J13").Value

'Clear Data
sourceSheet.Range("J7").Value = ""
sourceSheet.Range("J9").Value = ""
sourceSheet.Range("J11").Value = ""
sourceSheet.Range("J13").Value = ""
End Sub

我想在表格中添加新行 但是正如您在下张照片中看到的那样，数据超出了表的范围

Answer 1

您可以像这样调整表格的大小

dataSheet.ListObjects("Table1").Resize dataSheet.Range("$A$1:$F$" & nextRow)

Answer 2

Option Explicit
Sub add_product()

    Dim wsSource As Worksheet, wsData  As Worksheet
    Dim n As Long, i As Long, r As Long
    
    Set wsSource = Sheets("add product")
    Set wsData = Sheets("products")
    
    With wsData.ListObjects("table1")
        .ListRows.Add
        n = .ListRows.Count
                
        ' Input the form values into the Data sheet.
        For i = 1 To 5
            r = 3 + i * 2
            ,DataBodyRange.Cells(n, i) = wsSource.Cells(r, "J")
            If r >= 7 Then
               wsSource.Cells(r, "J") = ""
            End If
        Next
    End With
End Sub

Answer 3

写入表格的下一行

Sub AddProduct()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Add Product")
    Dim srg As Range: Set srg = sws.Range("J5,J7,J9,J11,J13")
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Products")
    Dim drg As Range: Set drg = dws.Range("A1").ListObject.ListRows.Add.Range
    
    Dim sCell As Range, dc As Long
    
    For Each sCell In srg.Cells
        dc = dc + 1
        drg.Cells(dc).Value = sCell.Value
        If dc > 1 Then sCell.ClearContents
    Next sCell
    
End Sub