bunu deneyebilirsiniz

Dim created As Boolean
Dim stopTimer As Boolean
Sub Start_Click()
    Dim row As Long, col As Long, i As Long
    Set cores = GetCores
    Optimize (False)
    
    For Each core In cores
        row = WorksheetFunction.RoundDown(i / 4, 0)
        col = (i - 4 * row) Mod 4
        If Not (created) Then
            If Not (row = 0 And col = 0) Then
                Range("CORE").Copy
                Range("CORE").Offset(2 * row, 2 * col).PasteSpecial
                Range("CORE").Offset(2 * row, 2 * col).Cells(1, 1).Value = "Core " & (i + 1)
            End If
        End If
        Range("CORE").Offset(2 * row, 2 * col).Cells(2, 1).Value = core.PercentProcessorTime & "%"
        i = i + 1
    Next
    Range("CPU").Value = Range("CORE").Offset(2 * row, 2 * col).Cells(2, 1).Value
    Range("CORE").Offset(2 * row, 2 * col).Cells(2, 1).Value = ""
    If Not (created) Then Range("CORE").Offset(2 * row, 2 * col).Delete xlShiftUp
    
    created = True
    Optimize (True)
    DoEvents
    If Not (stopTimer) Then Application.OnTime DateAdd("s", 2, DateTime.Now), "Start_Click"
    stopTimer = False
End Sub
Sub EndTimer()
    stopTimer = True
End Sub
Function GetCores()
    Dim objWMIService, cores, Proc, strQuery
    strQuery = "select * from Win32_PerfFormattedData_PerfOS_Processor"
    Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
    Set cores = objWMIService.ExecQuery(strQuery, , 48)
    Set GetCores = cores
End Function
Sub Optimize(opt As Boolean)
    Application.ScreenUpdating = opt
    Application.Calculation = IIf(opt, xlCalculationAutomatic, xlCalculationManual)
End Sub

Sub test()
Range("D5").Value = GetCores

End Sub