excelvbainsertcellexcel-tables

Data Entry Transfer to Multiples Tables to Specific Sheets

I have created a data entry form in a sheet and I want to be able to extract the entered information and add it to the end of the table on the sheet name given in cell D-3.

The images below will give you a better picture of what I am trying to achieve.enter image description here andenter image description here I Have This VBA Code but it putt data at the end of Table (Out side)

Dim shCountry As Worksheet
Dim shForm As Worksheet
Dim iCurrentRow As Integer
Dim sCountryName As String

Set shForm = ThisWorkbook.Sheets("Profit")
sCountryName = shForm.Range("D3").Value
Set shCountry = ThisWorkbook.Sheets(sCountryName)
iCurrentRow = shCountry.Range("A" & Application.Rows.Count).End(xlUp).Row + 1

With shCountry
         
    .Cells(iCurrentRow, 1) = shForm.Range("D5")
    .Cells(iCurrentRow, 2) = shForm.Range("D7")
    .Cells(iCurrentRow, 3) = shForm.Range("D9")
    .Cells(iCurrentRow, 4) = shForm.Range("D11")
    .Cells(iCurrentRow, 5) = shForm.Range("D13")
    .Cells(iCurrentRow, 6) = shForm.Range("D15")
    .Cells(iCurrentRow, 7) = shForm.Range("D17")
    .Cells(iCurrentRow, 8) = shForm.Range("D19")
    .Cells(iCurrentRow, 9) = shForm.Range("D21")
    .Cells(iCurrentRow, 10) = shForm.Range("D23")
    .Cells(iCurrentRow, 11) = shForm.Range("D25")
     
End With

shForm.Range("D5,D7,D9,D11,D13,D15, D17, D19, D21,D23,D25").Value = ""

MsgBox "Data submitted successfully!"

I want my data to appear in the last row of the table before the total row۔

Solution

  • Please, test the next code. It is not tested, but I think is should work as you need. I mean, it finds the necessary table, insert a row above the total and use it to drop the entry form data:

    Sub EntryDataAboveTotalRow()
Dim shCountry As Worksheet, shForm As Worksheet, iCurrentRow As Long, sCountryName As String
Dim tbl As ListObject 'the table where to insert the row

Set shForm = ThisWorkbook.Sheets("Profit")
sCountryName = shForm.Range("D3").value
Set shCountry = ThisWorkbook.Sheets(sCountryName)
Set tbl = shCountry.ListObjects(1) 'if more than a table in the sheet, use here the needed table name!

'insert a row in the table (above the Total one):
tbl.ListRows.Add (tbl.Range.rows.count - 1)
iCurrentRow = tbl.Range.rows.count - 1 'the TABLE row where to insert the data

'place the data entry values in the necessary fields:
With tbl
    .Range(iCurrentRow, 1) = shForm.Range("D5")
    .Range(iCurrentRow, 2) = shForm.Range("D7")
    .Range(iCurrentRow, 3) = shForm.Range("D9")
    .Range(iCurrentRow, 4) = shForm.Range("D11")
    .Range(iCurrentRow, 5) = shForm.Range("D13")
    .Range(iCurrentRow, 6) = shForm.Range("D15")
    .Range(iCurrentRow, 7) = shForm.Range("D17")
    .Range(iCurrentRow, 8) = shForm.Range("D19")
    .Range(iCurrentRow, 9) = shForm.Range("D21")
    .Range(iCurrentRow, 10) = shForm.Range("D23")
    .Range(iCurrentRow, 11) = shForm.Range("D25")
End With

'write the formula to summarize the 6th column (new row included), if it is not kept after row insertion:
'tbl.Range(tbl.Range.rows.count, 6).Formula = "=Sum(" & _
       tbl.DataBodyRange.Columns(6).Resize(tbl.DataBodyRange.rows.count - 1).address & ")"


shForm.Range("D5,D7,D9,D11,D13,D15, D17, D19, D21,D23,D25").value = ""

shCountry.Activate

MsgBox "Data submitted successfully!"
End Sub