Question

我有一个如下所示的映射表：

我需要做的是：

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

我正在尝试这个：

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

我哪里错了？

Answer 1

如果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而不是Address。这是完全不同的。

Answer 2

问题是我在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

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

2 个答案: