使用映射表在工作簿之间复制多个范围

Posted 2021-04-09

我有一个看起来像这样的映射表：

Range mapping

我需要做的是：

1. 将数据从文件1，工作表1的范围E22：E59复制到文件3，工作表1的范围G7：G42
2. 将文件1，工作表1的E61：E69范围内的数据复制到文件3，工作表1的范围G44：G52
3. 将数据范围E71：E74从文件1，工作表1复制到范围G53：文件3的G56，工作表1
4. 将数据从文件1，工作表2的范围G22：H69复制到文件3的工作表2的范围H7：I52
5. ...等到映射表的第一个空行

我正在尝试这个：

Sub Copy_Report_Data()

  Dim CurrentRow As Long
  Dim LastRow As Long
  Dim Path As String
  Dim MacroWorkbook As Workbook
  Dim SourceWorkbook As Workbook, SourceFileName As String, SourceTabName As String, SourceRangeFrom As String, SourceRangeTo As String, SourceRange As Range
  Dim TargetWorkbook As Workbook, TargetFileName As String, TargetTabName As String, TargetRangeFrom As String, TargetRangeTo As String, TargetRange As Range

  Application.ScreenUpdating = False

  Path = ActiveWorkbook.Path & ""

  LastRow = ActiveWorkbook.Sheets("Mapping").Range("C3").End(xlDown).Row

  For CurrentRow = 3 To LastRow

    If Cells(CurrentRow, 2).Value <> "" Then
      SourceTabName = Cells(CurrentRow, 2)
      TargetTabName = Cells(CurrentRow, 7)
    End If

    SourceRangeFrom = Cells(CurrentRow, 3)
    SourceRangeTo = Cells(CurrentRow, 4)

    TargetRangeFrom = Cells(CurrentRow, 8)
    TargetRangeTo = Cells(CurrentRow, 9)

    If Cells(CurrentRow, 1).Value <> "" And CurrentRow <> 3 Then
      TargetWorkbook.Save
      TargetWorkbook.Close
      SourceWorkbook.Close
    End If

    If Cells(CurrentRow, 1).Value <> "" Then
      SourceFileName = Cells(CurrentRow, 1)
      TargetFileName = Cells(CurrentRow, 6)
      Set SourceWorkbook = Workbooks.Open(Path & "Source" & SourceFileName)
      Set TargetWorkbook = Workbooks.Open(Path & "Target" & TargetFileName)
    End If

    SourceWorkbook.Sheets(SourceTabName).Range(SourceRangeFrom & ":" & SourceRangeTo).Copy
    TargetWorkbook.Sheets(TargetTabName).Range(TargetRangeFrom & ":" & TargetRangeTo).PasteSpecial Paste:=xlPasteValues
    TargetWorkbook.Sheets(TargetTabName).Range(TargetRangeFrom & ":" & TargetRangeTo).Replace What:="x", Replacement:="", LookAt:=xlPart

  Next CurrentRow

  Application.ScreenUpdating = True

End Sub

但是我在这一行上遇到运行时错误：

SourceWorkbook.Sheets(SourceTabName).Range(SourceRangeFrom & ":" & SourceRangeTo).Copy

我哪里错了？

答案

如果SourceRangeFrom应该是E3或类似的东西，那么只需在错误之前写debug.print SourceRangeFrom，看看它是什么。和SourceRangeTo一样。它们应该是某种格式，而不是地址。

另一种选择只是检查NullString，因为可能有些单元格是空的。因此在分配值后写下：

If SourceRangeTo = vbNullString Or SourceRangeTo = vbNullString Or _
    TargetRangeFrom = vbNullString Or TargetRangeTo = vbNullString Then Stop

---

如果您想要Cells(CurrentRow,3)的地址，请执行以下操作：

在您的代码中，而不是：

SourceRangeFrom = Cells(CurrentRow, 3)
SourceRangeTo = Cells(CurrentRow, 4)

分配如下：

SourceRangeFrom = Cells(CurrentRow, 3).Address
SourceRangeTo = Cells(CurrentRow, 4).Address

否则你得到的是Value而不是Cell的Address。这是完全不同的。

另一答案

问题是我在Cells条件下使用了If而没有指定工作簿。结果，值来自上次打开的工作簿，因此变量变空。

这是一个正确的版本，其中包含If条件中指定的工作簿和工作表：

Sub Copy_Report_Data()

  Dim CurrentRow As Long
  Dim LastRow As Long
  Dim Path As String
  Dim MacroWorkbook As Workbook
  Dim SourceWorkbook As Workbook, SourceFileName As String, SourceTabName As String, SourceRangeFrom As String, SourceRangeTo As String, SourceRange As Range
  Dim TargetWorkbook As Workbook, TargetFileName As String, TargetTabName As String, TargetRangeFrom As String, TargetRangeTo As String, TargetRange As Range

  Application.ScreenUpdating = False

  Set MacroWorkbook = ActiveWorkbook

  Path = MacroWorkbook.Path & ""
  LastRow = MacroWorkbook.Sheets("Mapping").Range("C3").End(xlDown).Row

  For CurrentRow = 3 To LastRow

    If MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 2).Value <> "" Then
      SourceTabName = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 2)
      TargetTabName = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 7)
    End If

    SourceRangeFrom = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 3)
    SourceRangeTo = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 4)

    TargetRangeFrom = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 8)
    TargetRangeTo = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 9)

    If MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 1).Value <> "" And CurrentRow <> 3 Then
      TargetWorkbook.Save
      TargetWorkbook.Close
      SourceWorkbook.Close
    End If

    If MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 1).Value <> "" Then
      SourceFileName = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 1)
      TargetFileName = MacroWorkbook.Sheets("Mapping").Cells(CurrentRow, 6)
      Set SourceWorkbook = Workbooks.Open(Path & "Source" & SourceFileName)
      Set TargetWorkbook = Workbooks.Open(Path & "Target" & TargetFileName)
    End If

    'Debug.Print "Timestamp         "; Format(Now(), "dd.MM.yyyy hh:mm:ss")
    'Debug.Print "CurrentRow        " & CurrentRow
    'Debug.Print "SourceWorkbook    " & "Source" & SourceFileName
    'Debug.Print "SourceTabName     " & SourceTabName
    'Debug.Print "SourceRangeFrom   " & SourceRangeFrom
    'Debug.Print "SourceRangeTo     " & SourceRangeTo
    'Debug.Print "TargetWorkbook    " & "Target" & TargetFileName
    'Debug.Print "TargetTabName     " & TargetTabName
    'Debug.Print "TargetRangeFrom   " & TargetRangeFrom
    'Debug.Print "---------------------------------------------------------"

    SourceWorkbook.Sheets(SourceTabName).Range(SourceRangeFrom & ":" & SourceRangeTo).Copy
    TargetWorkbook.Sheets(TargetTabName).Range(TargetRangeFrom).PasteSpecial Paste:=xlPasteValues
    TargetWorkbook.Sheets(TargetTabName).Cells.Replace What:="x", Replacement:="", LookAt:=xlPart

  Next CurrentRow

  TargetWorkbook.Save
  TargetWorkbook.Close
  SourceWorkbook.Close

  Application.ScreenUpdating = True

End Sub