Any idea to make code faster

hi,
this is working very slow, need some modification to work faster

Sub MainToOFBc()
Dim r As Range
Set r = Sheet8.Range("G5")
If r.Value > 0 Then
ThisWorkbook.Activate
Dim sh1 As Worksheet
Dim LR As Long
LR = Range("B" & Rows.count).End(xlUp).Row

'Application.Calculation = xlCalculationManual
Set sh1 = ActiveWorkbook.Worksheets("OF BC")
   Windows("Of_Bc.xlsb").Activate
On Error Resume Next
Application.ScreenUpdating = False
With sh1
   .Range("F10:F" & LR).Copy
Range("C2").PasteSpecial Paste:=xlPasteValues
.Range("A10:A" & LR).Copy
Range("D2").PasteSpecial Paste:=xlPasteValues
.Range("C10:C" & LR).Copy
Range("E2").PasteSpecial Paste:=xlPasteValues
.Range("H10:H" & LR).Copy
Range("F2").PasteSpecial Paste:=xlPasteValues
.Range("H10:H" & LR).Copy
Range("F2").PasteSpecial Paste:=xlPasteValues
.Range("J10:J" & LR).Copy
Range("G2").PasteSpecial Paste:=xlPasteValues
.Range("I10:I" & LR).Copy
Range("H2").PasteSpecial Paste:=xlPasteValues
.Range("D10:D" & LR).Copy
Range("I2").PasteSpecial Paste:=xlPasteValues
.Range("K10:M" & LR).Copy
Range("J2").PasteSpecial Paste:=xlPasteValues
.Range("B10:B" & LR).Copy
Range("M2").PasteSpecial Paste:=xlPasteValues
End With
Application.ScreenUpdating = True
Else
Exit Sub
End If

'Application.Calculation = xlCalculationAutomatic
End Sub

I have not had the chance to test this but perhaps

Sub MainToOFBc()
Dim dataSet
Dim r As Range
Set r = Sheet8.Range("G5")
If r.Value > 0 Then
ThisWorkbook.Activate
Dim sh1 As Worksheet
Dim LR As Long
LR = Range("B" & Rows.Count).End(xlUp).Row

'Application.Calculation = xlCalculationManual
Set sh1 = ActiveWorkbook.Worksheets("OF BC")
   Windows("Of_Bc.xlsb").Activate
On Error Resume Next
Application.ScreenUpdating = False
With sh1
    dataSet = Application.Index(.Range("A:K"), .Evaluate("ROW(10:" & LR & ")"), Array(6, 1, 3, 8, 10, 9, 4, 11))
End With
    Range("C2").Resize(UBound(dataSet, 1), UBound(dataSet, 2)).Value = dataSet
    Range("M2").Resize(UBound(dataSet, 1)).Value = sh1.Range("B10:B" & LR).Value
Application.ScreenUpdating = True
Else
Exit Sub
End If

'Application.Calculation = xlCalculationAutomatic
End Sub

@xlnitwit,

Toggling Calculation Mode will have a significant impact, and I believe you could tweak your Code as shown below;

Sub MainToOFBc()
Dim dataSet
Dim r As Range
Set r = Sheet8.Range("G5")
If r.Value > 0 Then
ThisWorkbook.Activate
Dim sh1 As Worksheet
Dim LR As Long
LR = Range("B" & Rows.Count).End(xlUp).Row

Set sh1 = ActiveWorkbook.Worksheets("OF BC")
   Windows("Of_Bc.xlsb").Activate
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With sh1
    dataSet = Application.Index(.Range("A:K"), .Evaluate("ROW(10:" & LR & ")"), Array(6, 1, 3, 8, 10, 9, 4, 11))
End With
    Range("C2").Resize(UBound(dataSet, 1), UBound(dataSet, 2)).Value = dataSet
    Range("M2").Resize(UBound(dataSet, 1)).Value = sh1.Range("B10:B" & LR).Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Else
Exit Sub
End If

End Sub

Regards.

@Winon,

It may speed things up, it may not. It will depend on the workbook.

Also, without knowing the workbook structure, I cannot be sure if turning off calculation would result in the wrong values being pasted somewhere. In fact, it may be the case that the order of copying and pasting affects the results of other columns that are then copied and pasted, in which case my suggestion would not work at all.

Administrative Note:

• We would love to continue to help you with your query, but first, before we can proceed…
• Please see Forum Rule #1 about proper thread titles and adjust accordingly...