Скопируйте диапазон вставки значений между книгами

Question

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

1. Рабочая книга панели инструментов
2. Исходная рабочая книга
3. Целевая рабочая книга

Подпрограмма считывает вводимые пользователем данные в рабочей книге Dashboard, которая будет выглядеть следующим образом:

Source cells    Target cells    Cell/Row
G28             H30             Cell
G29             H31             Row

Подпрограмма затем должна искать ячейку G28 в рабочей книге Source и копировать и вставлять ее в H30 в рабочей книге Target. Аналогично, подпрограмма должна искать ячейку G29 в рабочей книге Source, копировать эту ячейку и все вправо, а затем вставлять ее в H31 в Target bookbook.

Мне удалось реализовать функцию копирования / вставки для отдельной ячейки. ценности. Однако я не смог реализовать ту же функциональность для ввода типа строки. Я указал ниже, где ошибка. Я буду очень признателен за любую помощь с этим.

Sub transferSub()

Dim wbMain As Workbook: Set wbMain = ThisWorkbook
Dim wbMainDashboard As Worksheet: Set wbMainDashboard = wbMain.Worksheets("Dashboard")

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'Definition of file path for source and target workbooks
sourceModel = wbMainDashboard.Range("FILE_SOURCE") 'Pull from dashboard input
targetModel = wbMainDashboard.Range("FILE_TARGET") 'Pull from dashboard input

'Source and target workbooks
Dim wbSource As Workbook: Set wbSource = Workbooks(sourceModel) 'Workbook already open
Dim wbTarget As Workbook: Set wbTarget = Workbooks(targetModel) 'Workbook already open

'Source and target worksheet
Dim wskpInput_source As Worksheet: Set wskpInput_source = wbSource.Worksheets("INPUT (kp)")
Dim wsSCEInput_source As Worksheet: Set wsSCEInput_source = wbSource.Worksheets("INPUT (SCE)")
'Source and target worksheet
Dim wskpInput_target As Worksheet: Set wskpInput_target = wbTarget.Worksheets("INPUT (kp)")
Dim wsSCEInput_target As Worksheet: Set wsSCEInput_target = wbTarget.Worksheets("INPUT (SCE)")

'Procedures
Dim rng As Range: Set rng = wbMainDashboard.Range("Dashboard!E9:E15")
Dim i As Integer
For i = 1 To rng.Rows.Count
    cell_source = rng.Cells(i, 1)
    cell_target = rng.Cells(i, 1).Offset(0, 1)
    cell_cellrow = rng.Cells(i, 1).Offset(0, 3)

    If cell_cellrow = "Cell" Then 'If cell then copy paste value in that cell
        wskpInput_target.Range(cell_target) = wskpInput_source.Range(cell_source).Value
    ElseIf cell_cellrow = "Row" Then 'If row then copy and paste the row of cells
        wskpInput_source.Range(cell_source, cell_source.End(xlToRight)).Copy _
            wskpInput_target.Range(cell_target)  '---NEED HELP WITH THIS PART---
    End If
Next

End Sub

Answer 1

Ну, объект Range может получить либо Cells в качестве аргументов, либо String (подробности здесь ).

Жесткое кодирование диапазона со строковым аргументом будет выглядеть так:

wskpInput_source.Range("G28:L28").Copy _ 
destination:=wskpInput_target.Range(cell_target)

, но поскольку у вас уже есть переменная, содержащая первую ячейку ("G28") в строке, мынужно только найти последнюю ячейку, вы можете получить ее с помощью Function, как показано ниже:

Function GetLastCellInRow(sheetName As String, firstCell As String) As String

   Sheets(sheetName).Range(firstCell).End(xlToRight).Select
   GetLastCellInRow = ActiveCell.Address

End Function

, и вот как вы ее называете

'MySheet is the source sheet, so you need to modify that
cell_source_last = GetLastCellInRow(MySheet.Name, cell_source)

И складывая все вместе:

cell_source = rng.Cells(i, 1)
cell_target = rng.Cells(i, 1).Offset(0, 1)
cell_cellrow = rng.Cells(i, 1).Offset(0, 3)
'MySheet is the source sheet, so you need to modify that
cell_source_last = GetLastCellInRow(MySheet.Name, cell_source)

If cell_cellrow = "Cell" Then 'If cell then copy paste value in that cell
    wskpInput_target.Range(cell_target) = wskpInput_source.Range(cell_source).Value
ElseIf cell_cellrow = "Row" Then 'If row then copy and paste the row of cells
    wskpInput_source.Range(cell_source & ":" & cell_source_last).Copy _
        Destination:=wskpInput_target.Range(cell_target)
End If