Solved: Copy results to sheet2

[tqm1]

Dear Experts

In Listbox, I get required data against given Date with following codes.

These codes work fine to data into Listbox.

But now I want copy required data to Sheet2.

Please modify codes

Private Sub CommandButton1_Click()
Dim c As Range
Dim sDate As Date
Dim ws As Worksheet
Set ws = Worksheets("weights")
sDate = Me.TextBox1.Value
ListBox1.CLEAR

For Each c In ws.Range("E:E")
If c.Value = sDate Then
With ListBox1
.AddItem Format(ws.Cells(c.Row, "E").Value, "dd-mm-yy")
.List(.ListCount - 1, 1) = ws.Cells(c.Row, "B").Value
.List(.ListCount - 1, 2) = ws.Cells(c.Row, "J").Value
.List(.ListCount - 1, 3) = ws.Cells(c.Row, "K").Value
.List(.ListCount - 1, 4) = ws.Cells(c.Row, "G").Value
.List(.ListCount - 1, 5) = ws.Cells(c.Row, "F").Value
.List(.ListCount - 1, 6) = ws.Cells(c.Row, "N").Value
.List(.ListCount - 1, 7) = ws.Cells(c.Row, "O").Value
.List(.ListCount - 1, 8) = ws.Cells(c.Row, "M").Value
.List(.ListCount - 1, 9) = ws.Cells(c.Row, "D").Value
End With
End If
Next c
End Sub 

[Bob Phillips]

[vba]

Private Sub CommandButton1_Click()
Dim c As Range
Dim sDate As Date
Dim ws As Worksheet
Dim iRow As Long

Set ws = Worksheets("weights")
sDate = Me.TextBox1.Value

With Worksheets("Sheet2")
iRow = 1
For Each c In ws.Range("E:E")
If c.Value = sDate Then
.Cells(iRow, "A").Value = Format(ws.Cells(c.Row, "E").Value, "dd-mm-yy")
.Cells(iRow, "B").Value = ws.Cells(c.Row, "B").Value
.Cells(iRow, "C").Value = ws.Cells(c.Row, "J").Value
.Cells(iRow, "D").Value = ws.Cells(c.Row, "K").Value
.Cells(iRow, "E").Value = ws.Cells(c.Row, "G").Value
.Cells(iRow, "F").Value = ws.Cells(c.Row, "F").Value
.Cells(iRow, "G").Value = ws.Cells(c.Row, "N").Value
.Cells(iRow, "H").Value = ws.Cells(c.Row, "O").Value
.Cells(iRow, "I").Value = ws.Cells(c.Row, "M").Value
.Cells(iRow, "J").Value = ws.Cells(c.Row, "D").Value
End If
Next c
iRow = iRow + 1
End With
End Sub
[/vba]

[tqm1]

Dear Sir,

Your codes copy only the last row of data to first row.
I made some modifications as follows.
Now every thing is fine.

I changed the location of this line
iRow = iRow + 1

Private Sub CommandButton1_Click()
Dim c As Range
    Dim sDate As Date
    Dim ws As Worksheet
    Dim iRow As Long
     
    Set ws = Worksheets("weights")
    sDate = Me.TextBox1.Value
    
    Sheets("sheet2").Select
    Selection.Clear
    
    With Worksheets("Sheet2")
        iRow = 1
        For Each c In ws.Range("E:E")
            If c.Value = sDate Then
                .Cells(iRow, "A").Value = Format(ws.Cells(c.Row, "E").Value, "dd-mm-yy")
                .Cells(iRow, "B").Value = ws.Cells(c.Row, "B").Value
                .Cells(iRow, "C").Value = ws.Cells(c.Row, "J").Value
                .Cells(iRow, "D").Value = ws.Cells(c.Row, "K").Value
                .Cells(iRow, "E").Value = ws.Cells(c.Row, "G").Value
                .Cells(iRow, "F").Value = ws.Cells(c.Row, "F").Value
                .Cells(iRow, "G").Value = ws.Cells(c.Row, "N").Value
                .Cells(iRow, "H").Value = ws.Cells(c.Row, "O").Value
                .Cells(iRow, "I").Value = ws.Cells(c.Row, "M").Value
                .Cells(iRow, "J").Value = ws.Cells(c.Row, "D").Value
            End If
            iRow = iRow + 1
        Next c
        
    End With
        Unload Me
        Sheets("sheet2").Activate
    'sort the sheet
        Cells.Select
        Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Range("E18").Select
End Sub