VBA: Need code to grab a range (different workbook) based off of a specific text value, then paste them below the previous data (to keep a running dat

[BGAA2011]

So the code I currently have is button-based, and is located in Workbook A, when pressed, it opens Workbook B and pastes a designated range of data from Workbook A to Workbook B.

Unfortunately, I am now stuck. I know it seems simple, but I am at a writers block.

I need this code to not just grab a range from Workbook A, but search for the word "NEW" accross 4 columns, and then paste any row that contains "NEW" into Workbook B below the data that is already there.

This is a data tracker, so I want historical data which is why I need the code to recognize the old data and paste the new days' data under yesterdays.

I apoligize if this does not make sense, I am a little flustered as I do need this complete soon. Any help would be much apprecaited!

Here is what I have:

     'Copy the range from Workbook A
     wsI.Range("A1:H30").Copy
     'Paste to Workbook B
     wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False

 

[JLGWhiz]

**Can't figure out how to edit post, so I'm gonna double post real quick.

I just tried to use this code with new data and it worked perfectly, it pasted directly under the old data. However, it did still include the column header from the Source Workbook. I can't figure out how to tell it not to grab the column header.

You only have a few minutes in which to edit on this forum. If you make changes to the code, and create an anomally, you should re-post the code as you are currently using it so it can be analyzed. Trying to trouble shoot from a secondary narrative is not a good idea. The code I provided would not copy the headers unless the header is included in the search range and includes the criteria string.

 

[BGAA2011]

The search range is indeed grabbing the column header, and the header does include the word "NEW". Here is the code I have. It is pretty much an exact copy of yours.

Sub Transfer_Data()
 
MsgBox "Are you sure you want to run Tracker?"

'Open Tracker
Workbooks.Open Filename:="X:\Destination Workbook.xlsx.xlsm"

Dim wb1 As Workbook, wb2 As Workbook, wsI As Worksheet, wsO As Worksheet, fn As Range, fAdr
Set wb1 = Workbooks("Source Workbook.xlsm")
Set wb2 = Workbooks("Destination Workbook.xlsx.xlsm")
Set wsI = wb1.Sheets("Daily Change") 'Edit sheet name
Set wsO = wb2.Sheets("Tracking") 'Edit sheet name
Set fn = Intersect(wsI.Columns("D"), wsI.UsedRange).Find("New", , xlValues, xlPart)

    If Not fn Is Nothing Then
        fAdr = fn.Address
        Do
            wsI.Cells(fn.Row, "A").Resize(1, 8).Copy
            wsO.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
            Set fn = Intersect(wsI.Columns("D"), wsI.UsedRange).FindNext(fn)
        Loop While fn.Address <> fAdr
    End If
    
End Sub

 

[JLGWhiz]

Try this:

Sub Transfer_Data2()
MsgBox "Are you sure you want to run Tracker?"
'Open Tracker
Workbooks.Open Filename:="X:\Destination Workbook.xlsx.xlsm"
Dim wb1 As Workbook, wb2 As Workbook, wsI As Worksheet, wsO As Worksheet, fn As Range, fAdr
Set wb1 = Workbooks("Source Workbook.xlsm")
Set wb2 = Workbooks("Destination Workbook.xlsx.xlsm")
Set wsI = wb1.Sheets("Daily Change") 'Edit sheet name
Set wsO = wb2.Sheets("Tracking") 'Edit sheet name
Set fn = wsI.Range("D2", wsI.Cells(Rows.Count, 4).End(xlUp)).Find("New", , xlValues, xlPart)
    If Not fn Is Nothing Then
        fAdr = fn.Address
        Do
            wsI.Cells(fn.Row, "A").Resize(1, 8).Copy
            wsO.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
            Set fn = wsI.Range("D2", wsI.Cells(Rows.Count, 4).End(xlUp)).FindNext(fn)
        Loop While fn.Address <> fAdr
    End If
End Sub

 

[BGAA2011]

Perfect. Thank you very much for all your help!

 

[JLGWhiz]

Perfect. Thank you very much for all your help!

You're welcome,
regards, JLG