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
Bookmarks