Hello ejschulte2001,
This version will find the next available row in the second workbook.
'Written: May 11, 2010
'Updated: May 12, 2010
'Author: Leith Ross
Sub CopyData()
Dim Cell As Range
Dim DstWkb As Workbook
Dim DstWks As Worksheet
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range
Dim SrcCols() As Variant
Dim SrcWks As Worksheet
'Change Book2.xls to the name of the workbook you will be using.
Set DstWkb = Workbooks("Book2.xls")
'Name of the destination worksheet
Set DstWks = DstWkb.Worksheets("Sheet1")
'Name of the source data worksheet
Set SrcWks = ThisWorkbook.Worksheets("Sheet1")
'Set search range to start at E1 - Change this if you need to.
Set Rng = SrcWks.Range("E1")
Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = IIf(RngEnd.Row > Rng.Row, SrcWks.Range(Rng, RngEnd), Rng)
'Next available row on the destination worksheet.
Set RngEnd = DstWks.Cells.Find("*", , xlValue, xlWhole, xlByRows, xlPrevious, False)
If RngEnd Is Nothing Then
N = 1
Else
N = RngEnd.Row + 1
End If
'Data columns on source worksheet to copy.
SrcCols = Array("K", "D", "C", "O", "R", "S")
For Each Cell In Rng
If Cell = "PIR" Then
R = Cell.Row
DstWks.Cells(N, "A") = SrcWks.Cells(R, SrcCols(0))
DstWks.Cells(N, "B") = SrcWks.Cells(R, SrcCols(1))
DstWks.Cells(N, "C") = SrcWks.Cells(R, SrcCols(2))
DstWks.Cells(N, "D") = SrcWks.Cells(R, SrcCols(3))
DstWks.Cells(N, "E") = SrcWks.Cells(R, SrcCols(4))
DstWks.Cells(N, "K") = SrcWks.Cells(R, SrcCols(5))
N = N + 1
End If
Next Cell
End Sub
Bookmarks