Скопируйте и вставьте данные из разных книг в несколько ячеек

Question

Я новичок в VBA и пытаюсь скопировать данные из одной рабочей книги в другую. В моей «книге копирования» wb1 (формат .dbf) у меня есть 3 набора данных, которые я хочу скопировать в мою «книгу вставки», wb2 (формат .xlsm).

Мне нужно скопировать три «блока» «(которые я называю полосами) данных из одного ВБ в другой. Диапазон Band1 варьируется от "C2: M5", Band2 от "N2: X5" и Band3 от "Y2: AI5".

Я хочу, чтобы пользователь мог выбирать, куда он вставляет каждую полосу, в идеале, спрашивая ему нужно выбрать только первую ячейку диапазона для каждой полосы.

Пока у меня есть код, показанный ниже. Он копирует и вставляет только одну группу за раз, что означает, что я должен запустить ее три раза. Моя цель состоит в том, чтобы иметь подпрограмму, которая копирует и вставляет данные все сразу (запускает код один раз) и вставляет полосы / «чанки» всякий раз, когда пользователь этого хочет.

Надеюсь, это было достаточно ясно , Заранее благодарю за помощь!

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

[ОБНОВЛЕНИЕ С КОНЕЧНЫМ КОДОМ]

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

Answer 1

Вот простой пример, показывающий, как вы можете установить назначение вставки для каждого блока через поле ввода. Надеюсь, вы сможете адаптировать его к вашим точным настройкам.

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