【问题标题】:Loop through range and copy paste between workbooks循环遍历范围并在工作簿之间复制粘贴
【发布时间】:2019-10-15 10:33:10
【问题描述】:

我正在尝试在两个工作簿之间复制和粘贴数据。我正在使用第三个单独的工作簿,用户可以在其中指示复制范围、粘贴范围并指示它是要复制粘贴的单元格还是行。布局如下:

    Source      Target      Cell/Row
    G29         G29         Cell
    G30         G32         Cell
    G31         G33         Row

例如基于上面的VBA代码应该复制源工作簿中单元格G29中的内容并将其粘贴到目标工作簿中的G29中等等。我已将“源”范围定义为 rng 并遍历该范围以定义目标范围以及它是要复制粘贴的单元格还是行。但是,由于某种原因,我在首先定义我的 cell_source、cell_target 和 cell_cellrow 变量时遇到错误,并且在运行我将目标工作簿中的目标单元格设置为等于 cell_source_input 变量的循环时也遇到错误。如果有人能提供帮助,我将不胜感激。

    Sub transferScript()

    Dim wbMain As Workbook: Set wbMain = ThisWorkbook
    Dim wbMainDashboard As Worksheet: Set wbMainDashboard = wbMain.Worksheets("Dashboard")
    Dim CopyLastRow As Long
    Dim rng As Range: Set rng = Application.Range("Dashboard!E9:E15") 'change to E150 !!

    sourceModel = wbMainDashboard.Range("FILE_SOURCE")
    targetModel = wbMainDashboard.Range("FILE_TARGET")

    Dim wbSource As Workbook: Set wbSource = Workbooks.Open(Filename:=sourceModel)
    Dim wbTarget As Workbook: Set wbTarget = Workbooks.Open(Filename:=targetModel)

    'Source workbook
    Dim wsKpInput_source As Worksheet: Set wsKpInput_source = wbSource.Worksheets("INPUT (KP)")
    Dim wsSCEInput_source As Worksheet: Set wsSCEInput_source = wbSource.Worksheets("INPUT (SCE)")
    'Target workbook
    Dim wsKpInput_target As Worksheet: Set wsKpInput_target = wbTarget.Worksheets("INPUT (KP)")
    Dim wsSCEInput_target As Worksheet: Set wsSCEInput_target = wbTarget.Worksheets("INPUT (SCE)")

    'Error handling
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Dim i As Integer
    Dim cell_source As String
    Dim cell_target As String
    Dim cell_cellrow As String

    Dim cell_source_input As Variant

    For i = 0 To rng.Rows.Count
        'Definition of source cell, target cell, and cell_row input
        cell_source = rng.Cells
        cell_target = rng.Cells.Offset(rowOffset:=0, columnOffset:=1)
        cell_cellrow = rng.Cells.Offset(rowOffset:=0, columnOffset:=3)

        cell_source_input = wsKpInput_source.Range(cell_source)

        If cell_cellrow = "Cell" Then
            wsKpInput_target.Range(cell_source) = cell_source_input
        End If
    Next

    End Sub

【问题讨论】:

  • 错误号和描述是什么?生成错误时单元格中的哪些值?您希望通过rng.Cells 实现什么目标?还有rng.Cells.Offset?您两者都缺少的属性。如果您将rng 想象成一个正方形,那么rng.Cells 就是完全相同的正方形,该代码会生成错误并且什么也不做。如果您尝试获取单个单元格的值,那么rng.Cells(1) 会给您rng 中第一个单元格的值...但这不太可能是您想要做的事情。
  • 我猜你必须将cell_source = rng.Cells 更改为cell_source = rng.Cells(i,1).Address。而且你不需要cell_target(因为你不使用它)

标签: excel vba


【解决方案1】:

假设前面的代码没有错误:

Dim i As Integer
Dim cell_source As String
Dim cell_target As String
Dim cell_cellrow As String

Dim cell_source_input As Variant

For i = 0 To rng.Rows.Count
    'Definition of source cell, target cell, and cell_row input
    cell_source = rng.Cells
    cell_target = rng.Cells.Offset(rowOffset:=0, columnOffset:=1)
    cell_cellrow = rng.Cells.Offset(rowOffset:=0, columnOffset:=3)

    cell_source_input = wsKpInput_source.Range(cell_source)

    If cell_cellrow = "Cell" Then
        wsKpInput_target.Range(cell_source) = cell_source_input
    End If
Next

应该是:

Dim i As Integer
Dim cell_source As String
Dim cell_cellrow As String
Dim cell_source_input As Variant

For i = 0 To rng.Rows.Count
    'Definition of source cell, target cell, and cell_row input
    cell_source = rng.Cells(i,1).Value 'It seems to, but it is not clear with no sample
    cell_cellrow = rng.Cells(i,1).Offset(0, 3).Value
    cell_source_input = wsKpInput_source.Range(cell_source)

    If cell_cellrow = "Cell" Then
        wsKpInput_target.Range(cell_source) = cell_source_input
    End If
Next

希望它有所帮助...如果您提供一些输入和预期输出的示例,总是会更好。无论如何,在此过程之前的代码中存在一些问题:sourceModel 未定义,它似乎是一个范围,targetModel 未定义,它似乎是一个范围,Workbooks.Open(Filename:=sourceModel) 它正在尝试打开一个文件名的文件,它正在占用一个范围...检查它们...

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2012-09-02
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-10-17
    • 1970-01-01
    相关资源
    最近更新 更多