コードの処理速度を上げたい

現状Excelで何枚かのシート上で複数処理をするマクロを組んでいます。
ボタンを4つとかに分けてそれぞれで処理しているのですが、時間が結構かかってしまいます。
もっと処理速度を上げる方法をご存じの方がいらっしゃったらご助言いただきたいです。
使用しているコードは以下になります。
①同じ番号の行を一つにするためのコード

VBA
1コード
2Sub ボタン5_Click()
3
4Dim oShIn As Object
5Set oShIn = ThisWorkbook.Sheets("シート１")
6Dim oShOut As Object
7Set oShOut = ThisWorkbook.Sheets("シート２")
8
9Dim iRow As Long
10iRow = oShIn.UsedRange.Rows.Count
11oShIn.Range("A3:A" & iRow).Copy
12oShOut.Range("A3").PasteSpecial Paste:=xlPasteValues
13
14oShOut.Range("A:A").RemoveDuplicates Columns:=Array(1)
15
16oShOut.Range("G3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
17    & ",シート２!$A3,シート１!$G$3:$G$" & iRow & ")"
18oShOut.Range("EY3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
19    & ",シート２!$A3,シート１!$EY$3:$EY$" & iRow & ")"
20oShOut.Range("EZ3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
21    & ",シート２!$A3,シート１!$EZ$3:$EZ$" & iRow & ")"
22oShOut.Range("FA3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
23    & ",シート２!$A3,シート１!$FA$3:$FA$" & iRow & ")"
24oShOut.Range("FB3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
25    & ",シート２!$A3,シート１!$FB$3:$FB$" & iRow & ")"
26oShOut.Range("FC3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
27    & ",シート２!$A3,シート１!$FC$3:$FC$" & iRow & ")"
28oShOut.Range("FD3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
29    & ",シート２!$A3,シート１!$FD$3:$FD$" & iRow & ")"
30oShOut.Range("FE3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
31    & ",シート２!$A3,シート１!$FE$3:$FE$" & iRow & ")"
32oShOut.Range("FF3").Formula = "=SUMIF(シート１!$A$3:$A$" & iRow _
33    & ",シート２!$A3,シート１!$FF$3:$FF$" & iRow & ")"
34
35iRow = oShOut.UsedRange.Rows.Count
36oShOut.Range("G3:EY3:EZ3:FA3:FB3:FC3:FD3:FE3:FF3").Copy
37oShOut.Range("G4:FF" & iRow).PasteSpecial Paste:=xlPasteFormulas
38
39Application.CutCopyMode = False
40
41End Sub

② 階層を合した別シート毎を比較するコード

コード
Sub ボタン4_Click()

Dim i As Long

With ThisWorkbook
For i = 1 To .Sheets("シート3").UsedRange.Rows.Count
   DoEvents
   If .Sheets("シート2").Range("A" & i).Value = "" Then
'        Exit For
   ElseIf .Sheets("シート2").Range("A" & i).Value <> .Sheets("シート3").Range("A" & i).Value Then
       .Sheets("シート2").Rows(i).Insert Shift:=xlShiftDown
   End If
Next i
End With

End Sub