Need help cleaning up my currently working code - excel

Question

Just wondering if anyone can help me clean up my code. It currently works perfectly for what I need it to do. Just wondering if it can run faster. Right now it seems to open and close each workbook 3 times before moving to the next one.
Sub JanuaryMacro()
Dim strF As String, strP As String
Dim wb As Workbook
Range("B2:M2").clearcontents
'Edit this declaration to your folder name
strP = "\\My path" 'change for the path of your folder
strF = Dir(strP & "\*.xlsx")
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Do While strF <> vbNullString
Set wb = Workbooks.Open(strP & "\" & strF)
Range("Totals").Select
Selection.Copy
Windows("Monthly Report.xlsm").Activate
Range("D2:M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Set wb = Workbooks.Open(strP & "\" & strF)
Range("FG_Approvals").Select
Selection.Copy
Windows("Monthly Report.xlsm").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Set wb = Workbooks.Open(strP & "\" & strF)
Range("Allocations").Select
Selection.Copy
Windows("Monthly Report.xlsm").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
wb.Close SaveChanges:=False
strF = Dir()
Loop
Application.DisplayAlerts = True
End Sub

Answer 1

You should use references to your monthly-report-sheet, the new workbook and its sheet e. g. like this:
Sub JanuaryMacroVersion2()
Dim strF As String, strP As String
Dim mr As Worksheet
Dim wb As Workbook, ws As Worksheet
Set mr = ActiveSheet ' your monthly report
mr.Range("B2:M2").ClearContents
strP = "\\My path" 'change for the path of your folder
strF = Dir(strP & "\*.xlsx")
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Do While strF <> vbNullString
Set wb = Workbooks.Open(strP & "\" & strF)
Set ws = ActiveSheet
ws.Range("Totals").Copy
mr.Range("D2:M2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
ws.Range("FG_Approvals").Copy
mr.Range("C2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
ws.Range("Allocations").Copy
mr.Range("B2").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
wb.Close SaveChanges:=False
strF = Dir()
Loop
Application.DisplayAlerts = True
End Sub
If the range names like "FG_Approvals" refer to a workbook wide name, replace ws.Range("FG_Approvals")by wb.Range("FG_Approvals").
Next optimization step would be omitting copy/paste by assigning their Range.Value directly:
Sub JanuaryMacroVersion3()
Dim strF As String, strP As String
Dim mr As Worksheet
Dim wb As Workbook, ws As Worksheet
Dim lastRow As Long
Set mr = ActiveSheet
mr.Range("B2:M2").ClearContents
strP = "\\My path" 'change for the path of your folder
strF = Dir(strP & "\*.xlsx")
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Do While strF <> vbNullString
Set wb = Workbooks.Open(strP & "\" & strF)
Set ws = ActiveSheet
lastRow = mr.Cells(mr.Rows.Count, "D").End(xlUp).Row
mr.Cells(lastRow + 1, "D").Resize _
(ws.Range("Totals").Rows.Count, _
ws.Range("Totals").Columns.Count).Value _
= ws.Range("Totals").Value
lastRow = mr.Cells(mr.Rows.Count, "C").End(xlUp).Row
mr.Cells(lastRow + 1, "C").Resize _
(ws.Range("FG_Approvals").Rows.Count, _
ws.Range("FG_Approvals").Columns.Count).Value _
= ws.Range("FG_Approvals").Value
lastRow = mr.Cells(mr.Rows.Count, "B").End(xlUp).Row
mr.Cells(lastRow + 1, "B").Resize _
(ws.Range("Allocations").Rows.Count, _
ws.Range("Allocations").Columns.Count).Value _
= ws.Range("Allocations").Value
wb.Close SaveChanges:=False
strF = Dir()
Loop
Application.DisplayAlerts = True
End Sub