Copy and Pasting into next available row

**glancast16** · 07-09-2010, 03:56 PM

I have two sheets that I'm working with. The first sheet is an entry sheet where a part number and quantity are entered. The second sheet keeps a list of what is entered on the first sheet. Basically I want to cut the part number and quantity from sheet one, paste those values into sheet two, and then clear the info entered on sheet one. Then, when the next part number and quantity are entered into sheet one, I want that information cut and pasted directly under the previous information in sheet two. And then keep repeating. Any ideas on how to accomplish this with one macro? Thanks.

**Jbm444** · 07-09-2010, 04:41 PM

Can't tell exactly what you want done without more details/example worksheet, but this bit of code should be helpful for your purposes if you can figure it out and adapt it (pay attention especially to (rows.count, 1).end(xlup).offset(1,0), because that's how you get data into the next available row):

Sub extracter()
    Dim lastrow As Long
    Dim rowcount As Long
        With Sheet1
            lastrow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For rowcount = 1 To lastrow
                If .Cells(rowcount, 1).Value Like "*SOMESTRINGOFTEXTTHATYOUWANTTOFIND*" And .Cells(rowcount, 1).Value Like "*-*" And .Cells(rowcount, 1).Offset(-1, 0).Value Like "*SOMEOTHERSTRINGOFTEXT*" Then
                    Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = .Cells(rowcount, 1).Value
                    Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = .Cells(rowcount, 1).Offset(-1, 0).Value
                End If
              
            Next rowcount
        End With
End Sub

**protonLeah** · 07-09-2010, 04:59 PM

No workbook, eh?
Oh well, your macro will need lines such as:

Dim NextRow As Long
Dim LastRow as Long
Dim TestRow as Range

Then:

'rows to copy -->
LastRow=Sheets("source sheet").Cells(Rows.Count, "A").End(xlUp).Row
'where to start the paste  -->
NextRow = Sheets("dest sheet").Cells(Rows.Count, "A").End(xlUp).Row + 1

Then to copy and paste, maybe:

    For Each TestRow In Sheets("source sheet").Range("A2:A" & LastRow)
        Sheets("dest sheet").Range("A" & nextrow).EntireRow.Value = TestRow.EntireRow.Value
        nextrow = nextrow + 1
    Next TestRow

etc...