improve loop

The best way to improve your loop is to get rid of it.

In Pseudocode:

Copy all your data to sheet2

Insert a formula in an Empty column to to return a 1 if column A <> Name

Copy Paste Values

Use select Special to select all the 1's in our helper column.

Resize the selection to Delete all your flagged Rows

There is no loop so this should be fast.

Sub Macro1()

LR = Cells(Rows.Count, 1).End(xlUp).Row

Range("A1:G" & LR).Copy Sheets("Sheet2").Range("A1")

Sheets("Sheet2").Select

With Range("H1:H" & LR)
 .FormulaR1C1 = "=IF(RC[-7]<>""Name"",1,"""")"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 1).Select
End With
Selection.EntireRow.Delete
[A1].Select
End Sub

Or test such code:

Sub searchandfindwithfind()

Dim data As Worksheet
Dim report As Worksheet
Dim name As String
Dim finalrow As Long

'new variables
Dim i As Long, j As Long, sourcecell As Range

Set data = Sheet3
Set report = Sheet4
name = report.Range("D2").Value

data.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

'new code

Set sourcecell = Range("A2:A" & finalrow).Find(what:=name, after:=Range("A" & finalrow), LookIn:=xlValues, lookat:=xlWhole)
If Not sourcecell Is Nothing Then
  i = sourcecell.Row
  j = i
  Do
    Union(Cells(i, 2), Cells(i, 5), Cells(i, 12)).Copy 'IN CASE, HOW COULD I SPECIFY SPECIFIC COLUMNS, FOR EX: (i,2), (i,5), (i,7)
  ' what if there are more than 100 results, may be:
    report.Range("Z" & report.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Set sourcecell = Range("A2:A" & finalrow).FindNext(sourcecell) '(what:=name, after:=Range("A" & finalrow), LookIn:=xlValues, lookat:=xlWhole)
    i = sourcecell.Row
  Loop Until i = j
End If

report.Select

Range("B2").Select

'new code
Set report = Nothing
Set data = Nothing

End Sub

EDIT: I have added a sample of attachment of what I am attempting to accomplish

hello kaper- I am testing your suggested code. It is not looping to the next record in this section:

Set sourcecell = Range("A2:A" & finalrow).Find(what:=name, after:=Range("A" & finalrow), LookIn:=xlValues, lookat:=xlWhole)
If Not sourcecell Is Nothing Then 'IT DOES NOT GO TO THE NEXT RECORD FROM HERE;RETURNS ONLY ONE
  i = sourcecell.Row
  j = i
  Do
    Union(Cells(i, 2), Cells(i, 5), Cells(i, 12)).Copy 
  ' what if there are more than 100 results, may be:
    report.Range("Z" & report.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Set sourcecell = Range("A2:A" & finalrow).FindNext(sourcecell) '(what:=name, after:=Range("A" & finalrow), LookIn:=xlValues, lookat:=xlWhole)
    i = sourcecell.Row
  Loop Until i = j
End If

have you seen the yellow banner at the top of the page? Please follow the advice

According to post #4 attachment a VBA beginner starter demonstration :

PHP Code: 

Sub Demo1()
    Sheet2.UsedRange.Columns(1).Copy Sheet2.[K1]
    Sheet1.[C1:D1].Copy Sheet2.[C1]
    Sheet1.UsedRange.AdvancedFilter xlFilterCopy, Sheet2.[K1].CurrentRegion, Sheet2.[A1:D1]
    Sheet2.[K1].CurrentRegion.Clear
End Sub 


The same demonstration revamped :

PHP Code: 

Sub Demo1r()
    With Sheet2.UsedRange.Columns
        .Item(1).Copy .Item(11)
         Sheet1.[C1:D1].Copy .Range("C1")
         Sheet1.UsedRange.AdvancedFilter xlFilterCopy, .Item(11), .Range("A1:D1")
        .Item(11).Clear
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

The example you posted in post #4 is quite different than what has been posted in post #1
Moreover, I suspect that example data is oversimplified (see below for the attachment suggestions), because for such data with unique ID, a simple VLOOKUP would do the job.
Use in C2 in sheet 2:

Formula:

=VLOOKUP(A2,Sheet1!A:D,3,0)

and the same in D2, but with 4 (instead of 3) as third argument.

---
1. Make sure that your sample data are truly REPRESENTATIVE of your real data. (If there are typical cases like: all unique values/duplicates could occur, day/night, nobody present/several persons at once, before/on/past due, empty cells between data, mixed text/numbers, etc. - please show them all, or at least indicate in text). The use of unrepresentative data is very frustrating and can lead to long delays in reaching a solution.

2. Make sure that your desired solution(s) is/are also shown (mock up the results manually).

3. Make sure that all confidential/restricted information (either personal or business) like real e-mails, social security numbers, bank accounts, etc. is removed first!!

This works when the keys are properly entered - In your sample there were 3 East 95's for instance.

But try it and see whether it works for you:

Sub hgcas(): Dim K, A, B, T, Key As String, r As Long, s As Long
Dim w1 As Worksheet, w2 As Worksheet
Set w1 = Sheets("Sheet1"): Set w2 = Sheets("Sheet2"): A = w1.UsedRange
K = w2.Range("H1").CurrentRegion: B = w2.Range("A1").CurrentRegion
T = w2.Range("L1").Resize(UBound(K, 1), UBound(B, 2) + 2)
With CreateObject("Scripting.Dictionary")
            For r = 2 To UBound(K)
Key = K(r, 1) & K(r, 2): .Item(Key) = r
            For s = 2 To UBound(A): Key = A(r, 1) & A(r, 3)
If .Exists(Key) Then
T(r, 1) = B(r, 1): T(r, 2) = K(r, 1): T(r, 3) = B(r, 2): T(r, 4) = B(r, 3)
T(r, 6) = B(r, 4): T(r, 7) = B(r, 5): T(r, 5) = T(r, 7) / T(r, 6): Exit For
End If: Next s: Next r
End With: w2.Range("L1").Resize(UBound(K, 1), UBound(B, 2) + 2) = T
End Sub