Help altering VBA to copy/paste from within workbook to between workbooks

[combatcrab]

Hiya!

After hours of googling to see if I can figure this out on my own...I give in.

I've been running this macro for quite some time to copy paste values based on criteria between tabs of the same workbook. I now have a need to copy/paste to a tab in another workbook (saved in the same folder). Can you help me?

Here's the existing code:

Sub SearchForUSACEHR()

    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    
    On Error GoTo Err_Execute
    
    'Start search in row 4
    LSearchRow = 2
    
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2
    
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
        
        'If value in column E = "USACEHR", copy entire row to Sheets("USACEHR")
        If Range("L" & CStr(LSearchRow)).Value = "USACEHR" Then
            
            'Select row in Sheet2 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            
            'Paste row into Sheets("USACEHR") in next row
            Sheets("USACEHR").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            
            'Go back to Sheets("Modifications" to continue searching
            Sheets("Modifications").Select
            
        End If
        
        LSearchRow = LSearchRow + 1
        
    Wend
    
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    
   
    
    Exit Sub
    
Err_Execute:
    MsgBox "An error occurred."
    
End Sub

Some changes to the environment:

Would like to copy from ("Sheet2") in workbook: "FY16_MOD_SUMMARY" to ("Sheet13") in workbook: FY16_Stipend_Track_Form.

These are the worksheet assignments as viewed in the VBA editors, the actual titles are "LINE_ITEMS" and "USACE-HR-0001 TOs" respectively.

Lastly, I'm no longer looking for text, but instead a string. Values I'm now searching for will be from 0001 to 9999, (Yes, with the leading 0s).

Thanks!

-Jerry

 

[combatcrab]

Making a little bit of headway, but still would like some help if someone has ideas. Now using the below macro with some success, but the problem is that it's very very slow. The macro opens the second workbook, copies a row, closes the workbook and starts all over again. Additionally, is there a way to clear existing data in the destination worksheet before the copy/paste begins?

Thanks again for your help!

-Jerry

Sub SearchUSACEHR()Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To LastRow


If Cells(i, 8).Value = "USACEHR" Then


Range(Cells(i, 1), Cells(i, 20)).Select
Selection.Copy
Workbooks.Open Filename:="G:\_HRD_*******************k_Form.xlsm"
Worksheets("USACE-H************").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub