遍历范围并在工作簿之间复制粘贴

时间:2019-10-15 10:33:10

标签: excel vba

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

    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

1 个答案:

答案 0 :(得分: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未定义,并且似乎是一个范围,{{1 }},它正在尝试打开一个文件名,该文件名带有一个范围...检查它们...