copy data from listbox to sheet after headers and before Total row

[Mussa]

Hi
I have this code to copy data from listbox to sheet

Private Sub cmdSend_Click()
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With
End Sub

bu I need adapting by copy after row6 and before total row and if I have rows in listbox more than empty rows inside the sheet then should insert new rows with the same borders ,if I have rows in listbox less than empty rows inside the sheet then should delete empty rows

here is the structure inside sheet

Sample.xlsm
	A	B	C	D	E
6	ITEM	ID	QTY	UNIT PRICE	TOTAL
7
8
9
10	TOTAL				.00
SL

Cell Formulas
Range	Formula
E10	E10	=SUM(E7:E9)

when fill listbox

the result should be

Sample.xlsm
	A	B	C	D	E
6	ITEM	ID	QTY	UNIT PRICE	TOTAL
7	1	ABSS-100	10	10.00	100.00
8	2	*** TYYY 2000	12	22.00	264.00
9	3	ASDE9900/1200	2	22.00	44.00
10	4	XDD*7777	2	12.00	24.00
11	TOTAL				432.00
SL

Cell Formulas
Range	Formula
E11	E11	=SUM(E7:E10)

 

[jolivanes]

Sub What_Is_The_Answer()
Dim c As Range
    With Sheets("SL")
        Set c = .Columns(1).Find("TOTAL", , , 1)
        If Not c Is Nothing Then
            MsgBox "The word ""Total"" is at " & c.Address
                Else
            MsgBox "No such value in Column A."
        End If
    End With
MsgBox Len(ActiveSheet.Name)
End Sub

What do you get when you run this snippet?

 

[Mussa]

this is what I got.

 

[jolivanes]

It all works on a workbook I made here. Maybe someone else sees the problem.

 

[Akuini]

@Mussa
Maybe this:
I'm assuming:
1. You've already populate the listbox using .List property as jolivanes suggested:

In the UserForm Module (Change the Range to the needed amount and where the data is.)

Private Sub UserForm_Initialize()
Me.ListBox1.List = Sheets("Sheet1").Range("L2:N" & Sheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Row).Value
End Sub

2. Maximum data is 10000 row.
3. Data always start at row 7
4. TOTAL row already exist.
The code will insert n empty rows below row 7, at the end any empty rows will be deleted.

Private Sub cmdSend_Click()
Dim k As Long, n As Long

With Sheets("SL")
    k = .Range("A" & Rows.Count).End(xlUp).Row
    n = 10000  'max data is 10000 row, change to suit
    .Range("A8").Resize(n).EntireRow.Insert (xlUp) 'insert n rows
End With
   
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With

Sheets("SL").Range("A8").Resize(n + k).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

 

[Mussa]

Hi Akuini,
it's perfect !
just I need replace new data with old data have already existed from listbox to sheet . I don't need to copy to the bottom inside the sheet as the code does it
in other meaning should clear data under headers before copy data from listbox.
thanks .

 

[Akuini]

Are you saying there's probably existing data before you run the code & you need to remove it first?
Try this:

Private Sub cmdSend_Click()
Dim k As Long, n As Long
Dim c As Range
With Sheets("SL")
    Set c = Range("A:A").Find(What:="TOTAL", LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
    Range("A7:A" & c.Row - 1).ClearContents
    k = .Range("A" & Rows.Count).End(xlUp).Row
    n = 10000  'max data is 10000 row, change to suit
    .Range("A8").Resize(n).EntireRow.Insert (xlUp) 'insert n rows
End With
   
    With Me.ListBox1
        If .ListCount > 0 Then
            Sheets("SL").[a7].Resize(.ListCount, .ColumnCount) = .List
        End If
    End With

Sheets("SL").Range("A8").Resize(n + k).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

 

[jolivanes]

Still can't figure out why the error.
What about this?

Private Sub CommandButton1_Click()
Dim sh4 As Worksheet    '<---- Change as required
Set sh4 = Worksheets("Sheet4")    '<---- Change as required
With sh4    '<---- Change as required
    .Cells(1).Offset(6).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 6, 5).Delete Shift:=xlUp
    .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount).Value = ListBox1.List
With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Value = "TOTAL"
    .Interior.Color = RGB(255, 255, 0)
    .Offset(, 4).Formula = "=SUM(E7:E" & Cells(Rows.Count, 1).End(xlUp).Row - 1 & ")"
End With
End With
Cells(1).Offset(6).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 6, 5).HorizontalAlignment = xlCenter
Unload Me
End Sub

One of the suggestions, Akuini's or this one, should work for you.

 

[Mussa]

well done, Akuini !
thank you so much for the assistance.

 

[Mussa]

Still can't figure out why the error.
What about this?

finally it works but except one thing . it delete the borders .
anyway thank you .

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.