SImple way to select various cells and copy then paste to a new excel workbook using VBA

Question

I want to be able to have a VBA command button that opens a csv file and then automatically copy various cells then paste them into a new workbook into different cell locations.

I want to copy the following cells from a source workbook and paste them into a new workbook in the following cells (see table below)

Source Workbook	New Workbook
A2	C8
B2	F7
C2	F6
E2	F8
D2	G8

I have this working code but it takes too long to execute, what can i do to stream line it?

Private Sub CommandButton3_Click()

FileToOpen = Application.GetOpenFilename(FileFilter:="Excel workbook(*.csv),*.csv", Title:="Open Report File")
Dim sourceworkbook As Workbook
Dim currentworkbook As Workbook
Set currentworkbook = ThisWorkbook
Set sourceworkbook = Application.Workbooks.Open(FileToOpen)

With sourceworkbook
sourceworkbook.Worksheets(1).Range("C2"").Copy
currentworkbook.Activate
currentworkbook.Worksheets("Sheet1").Activate
currentworkbook.Worksheets("Sheet1").Range("F6").Select
sourceworkbook.Worksheets(1).Range("C2").Copy
ActiveSheet.Paste
End With

With sourceworkbook
sourceworkbook.Worksheets(1).Range("B2").Copy
currentworkbook.Activate
currentworkbook.Worksheets("Sheet1").Activate
currentworkbook.Worksheets("Sheet1").Range("F7").Select
sourceworkbook.Worksheets(1).Range("B2").Copy
ActiveSheet.Paste
End With

With sourceworkbook
sourceworkbook.Worksheets(1).Range("E2").Copy
currentworkbook.Activate
currentworkbook.Worksheets("Sheet1").Activate
currentworkbook.Worksheets("Sheet1").Range("F8").Select
sourceworkbook.Worksheets(1).Range("E2").Copy
ActiveSheet.Paste
End With

With sourceworkbook
sourceworkbook.Worksheets(1).Range("D2").Copy
currentworkbook.Activate
currentworkbook.Worksheets("Sheet1").Activate
currentworkbook.Worksheets("Sheet1").Range("G8").Select
sourceworkbook.Worksheets(1).Range("D2").Copy
ActiveSheet.Paste
End With

With sourceworkbook
sourceworkbook.Worksheets(1).Range("A2").Copy
currentworkbook.Activate
currentworkbook.Worksheets("Sheet1").Activate
currentworkbook.Worksheets("Sheet1").Range("C8").Select
sourceworkbook.Worksheets(1).Range("A2").Copy
ActiveSheet.Paste
End With

sourceworkbook.Close

End Sub

All your `With` statements are not actually being used if you're referencing the workbooks inside the statements anyway. Have a read [here](https://stackoverflow.com/a/35864330/1727575) in regards to avoid using `Select` and `Activate` statements which should help with your use of `With` statements and also improve speed — Kairu, Mar 10 '23 at 04:24

VBasic2008 · Answer 1 · 2023-03-10T05:33:40.907

Import Cell Values From Closed Workbooks

Option Explicit

Private Sub CommandButton3_Click()
    
    Dim sAddr(): sAddr = VBA.Array("A2", "B2", "C2", "E2", "D2")
    Dim dAddr(): dAddr = VBA.Array("C8", "F7", "F6", "F8", "G8")
    
    Dim sPath: sPath = Application.GetOpenFilename( _
        FileFilter:="Excel workbook(*.csv),*.csv", _
        Title:="Open Report File")
    
    If VarType(sPath) = vbBoolean Then
        MsgBox "Canceled.", vbExclamation
        Exit Sub
    End If
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sPath)
    Dim sws As Worksheet: Set sws = swb.Worksheets(1)
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1")
   
    Dim aUB As Long: aUB = UBound(sAddr)
    
    Dim a As Long
    
    For a = 0 To aUB
        dws.Range(dAddr(a)).Value = sws.Range(sAddr(a)).Value
    Next a
    
    swb.Close SaveChanges:=False
    
    MsgBox "Data imported.", vbInformation

End Sub

SImple way to select various cells and copy then paste to a new excel workbook using VBA

1 Answers1

Import Cell Values From Closed Workbooks