Sub Import_New()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        
        OpenBook.Sheets(1).Range("D7:AY13").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D7:AY13").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D26:AY32").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D26:AY32").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D42:AY48").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D42:AY48").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D57:AY63").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D57:AY63").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D73:AY79").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D73:AY79").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D88:AY94").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D88:AY94").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D104:AY110").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D104:AY110").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D119:AY125").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D119:AY125").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D135:AY141").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D135:AY141").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D150:AY156").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D150:AY156").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D166:AY172").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D166:AY172").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D181:AY187").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D181:AY187").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D197:AY203").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D197:AY203").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D212:AY218").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D212:AY218").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D228:AY234").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D228:AY234").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D243:AY249").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D243:AY249").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D259:AY265").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D259:AY265").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D274:AY280").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D274:AY280").PasteSpecial xlPasteValues
        OpenBook.Sheets(1).Range("D290:AY296").Copy
        ThisWorkbook.Worksheets("New HR072").Range("D290:AY296").PasteSpecial xlPasteValues
        
        
        OpenBook.Close False
        
    End If
End Sub

Wasn't expecting the flashing, is there a better way of achieving this

CodePudding user response：

If you don't want the flashing going on, you can use

Application.ScreenUpdating = False

Don't forget to use

Application.ScreenUpdating = True

at the end of your code.

What you can also use if this is a re-occuring thing, is using a function like so

Sub yourSub()
    improvePerformance True
    'do your code
    improvePerformance False
End Sub
Function improvePerformance(Optional Yes As Boolean = True) As Boolean
    With Application
    If Yes Then
      .ScreenUpdating = False
      .DisplayStatusBar = False
'      .Calculation = xlCalculationManual 'causes too many rewrites/extra time needed in code, copy pasting as value reduces plenty of time regarding this
      .EnableEvents = False
      .EnableCancelKey = xlInterrupt
    Else
      .ScreenUpdating = True
      .DisplayStatusBar = True
'      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
      .EnableCancelKey = xlDisabled
    End If
    End With
End Function

Regardless it might also be good to put your sheet in a variable to have a better readability:

Dim ws As WorkSheet
Set ws = ThisWorkbook.Sheets("New HR072")

Hope this helps :)

CodePudding user response：

Copying values directly

Option Explicit
Sub Import_New()

    Dim FileToOpen As Variant
    Dim wbBook As Workbook, wsBook As Worksheet
    Dim wsCopy As Worksheet, ar, i As Long
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", _
                 FileFilter:="Excel Files (*.xls*),*xls*")
    
    ' ranges
    ar = Array(7, 26, 42, 57, 73, 88, 104, 119, 135, 150, 166, _
              181, 197, 212, 228, 243, 259, 274, 290)
              
    If FileToOpen <> False Then
    
        Set wbBook = Application.Workbooks.Open(FileToOpen, ReadOnly:=True)
        Set wsBook = wbBook.Sheets(1)
        Set wsCopy = ThisWorkbook.Sheets("New HR072")
        
        Application.ScreenUpdating = False
        For i = 0 To UBound(ar)
            ' expand to 7 rows col D:AY
            wsCopy.Cells(ar(i), "D").Resize(7, 48).Value = wsBook.Cells(ar(i), "D").Resize(7, 48).Value
        Next
        Application.ScreenUpdating = True
        wbBook.Close False
        MsgBox "Copied from " & FileToOpen, vbInformation
        
    End If
    
End Sub