Question

我正在尝试实现一个简单的子程序，该子程序可以将单个单元格值或单元格行从源工作簿复制并粘贴到目标工作簿。这样，用户在工作时将打开三个单独的工作簿：

仪表板工作簿
源工作簿
目标工作簿

该子程序读取仪表板工作簿中的用户输入，如下所示：

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

然后，该子程序应该在Source工作簿中查找单元格G28，然后将其复制粘贴到Target工作簿中的H30中。同样，该子对象应该在Source工作簿中查找单元格G29，并将该单元格和所有内容复制到右侧，然后将其粘贴到Target工作簿中的H31。

我设法为单个单元格值实现了复制/粘贴。但是，我无法为行类型输入实现相同的功能。我在下面指出了错误所在。我将非常感谢对此的任何帮助。

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（详细信息here）。

使用字符串参数对范围进行硬编码如下所示：

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

在工作簿之间复制值的粘贴范围

1 个答案: