Copy and paste data from different workbooks to several cells

Question

I am new to VBA and I am trying to copy data from one workbook to another. In my "copying workbook", wb1 (.dbf format) I have 3 sets of data I want to copy to my "pasting workbook", wb2 (.xlsm format).

I need to copy three "chunks" (which I call bands) of data from one WB to the other. Band1 ranges from "C2:M5", Band2 from "N2:X5" and Band3 from "Y2:AI5".

I want the user to be able to choose where he is pasting each band, ideally by asking him to select only the first cell of the range for each band.

So far, I have the code showed below. It only copies and pastes one band at a time, which means I have to run it three times. My goal is to have a routine which copies and pastes the data all at once (running the code once) and that pastes the bands/"chuncks" whenever the user wants them to.

I hope this was clear enough. Thank you in advance for all your help!

Sub CopyData()

' Keyboard shortcut: Ctrl+d

Dim band As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook

Set band = InputBox("Choose bands 1, 2 or 3:")

Set wb1 = Workbooks.Open("C:\Users\mmm\CopyFile.dbf") ' File I want to copy the data from
Set wb2 = Workbooks.Open("C:\Users\mmm\PasteFile.xlsm") ' File I want to paste my data to

If band = 1 Then

    wb1.Worksheets(dbf_name).Range("C2:M5").Copy 'Range of Band1 to copy
    wb1.Close savechanges:=False
    Application.DisplayAlerts = True

    Application.DisplayAlerts = False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select

ElseIf band = 2 Then

    wb1.Worksheets(dbf_name).Range("N2:X5").Copy 'Range of Band2 to copy
    wb1.Close savechanges:=False
    Application.DisplayAlerts = True

    Application.DisplayAlerts = False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select

ElseIf band = 3 Then

    wb1.Worksheets(dbf_name).Range("Y2:AI5").Copy 'Range of Band3 to copy
    wb1.Close savechanges:=False
    Application.DisplayAlerts = True

    Application.DisplayAlerts = False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select

End If
End Sub

[UPDATE WITH FINAL CODE]

Sub CopyData()

' Keyboard shortcut: Ctrl+d

Dim dbf_path As String
Dim dbf_name As String
Dim rCopy As Range
Dim i As Long
Dim rPaste As Range
Dim wb1 As Workbook

dbf_path = "C:\Users\mmm\CopyFile.dbf"
dbf_name = "filename_dbf"
Set wb1 = Workbooks.Open(dbf_path)

ThisWorkbook.Activate

Set rCopy = wb1.Worksheets(dbf_name).Range("C2:M5,N2:X5,Y2:AI5")

For i = 1 To rCopy.Areas.Count 'loop through each distinct block or area
    Set rPaste = Application.InputBox("Enter starting cell for range " & i, Type:=8) 'invite paste cell, specifying range input
    If rPaste.Count > 1 Then Set rPaste = rPaste(1) 'if more than one cell selected use the first one
    rCopy.Areas(i).Copy rPaste 'paste
Next i

wb1.Close savechanges:=False

End Sub

SJR SJR · Accepted Answer · 2020-04-16T17:56:52

Here's a simple exampleto show how you might set the paste destination for each block via an input box. Hopefully you can adapt it to your precise set up.

Sub x()

Dim rCopy As Range, i As Long, rPaste As Range

Set rCopy = Range("C2:M5,N2:X5,Y2:AI5") 'define ranges to copy

For i = 1 To rCopy.Areas.Count 'loop through each distinct block or area
    Set rPaste = Application.InputBox("Enter starting cell for range " & i, Type:=8) 'invite paste cell, specifying range input
    If rPaste.Count > 1 Then Set rPaste = rPaste(1) 'if more than one cell selected use the first one
    rCopy.Areas(i).Copy rPaste 'paste
Next i

End Sub

Copy and paste data from different workbooks to several cells

1 Answers