Question

大家好，我对VBA非常新，只是对Excel不老，而且我正在尝试编写一个允许用户选择文件的宏，然后从该文件中复制2个不同的数据范围并粘贴它进入原始的活动工作簿。

好的，所以在审核之后我将代码更改为：

Sub GetFastScanData()

'Add file name to Active Sheet
Dim intChoice As Integer
Dim strPath As String 

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show

If intChoice <> 0 Then
  strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
  Cells(1, 1) = strPath

  'Open Source WorkBook
  Dim sourceWB As Workbook
  Set sourceWB = Application.Workbooks.Open(strPath)

  'Give names to items
  Dim Var1 As String
  Var1 = "BT16"

  Dim Var2 As Integer
  Var2 = 1

  Dim Var3 As String
  Var3 = "BU16"

  'Copy from Source to Target
  sourceWB.Sheets(Var2).Range("F1:F55000").Copy _
    Destination:=Workbooks.Sheets("PI-2 data").Range(Var1)

  sourceWB.Sheets(Var2).Range("I2:I55000").Copy _
    Destination:=Workbooks.Sheets("PI-2 data").Range(Var3)

  'Close Source WorkBook wo/Save
  sourceWB.Close False

End If

End Sub

我现在唯一的问题是，由于2014年12月9日的Windows更新，我认为我收到了错误消息？编译错误：未找到数据

原帖：

我对VBA很新，但我绝对不是Excel的新手。我有一个宏的问题，试图将数据从选定的文件复制到当前工作簿。对于宏的斜体部分，我得到了超出范围的错误。非常感谢任何帮助！

Sub GetFastScanData()

    'Add file name to Active Sheet
    Dim intChoice As Integer
    Dim strPath As String
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    intChoice = Application.FileDialog(msoFileDialogOpen).Show
    If intChoice <> 0 Then
    strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    Cells(1, 65) = strPath

    'Open Source WorkBook
    Application.Workbooks.Open (strPath)

    'Give names to workbooks and items
    Dim Var1 As String, Var1R As String
    Var1 = ActiveWorkbook.Name
    Var1R = "BT16"

    Dim Var2 As String, Var2R As String
    Var2 = ActiveWorkbook.Name
    Var2R = 1

    Dim Var3 As String, Var3R As String
    Var3 = ActiveWorkbook.Name
    Var3R = "BU16"

    'Copy from Source to Target
    *sourceWB.Sheets(Var2R).Columns(6).EntireColumn.Copy _
    Destination:=Workbooks(Var1).Sheets("PI-2 data").Range(VarR1)*

    Sheets(Var2R).Columns(9).EntireColumn.Copy _
    Destination:=Workbooks(Var3).Sheets("PI-2 data").Range(Var3R)

    'Close Source WorkBook wo/Save
    Workbooks(Var2).Close False

    End If

End Sub

Answer 1

如果您要复制整个列，则目标范围必须位于第1行。否则，没有足够的行来容纳您尝试粘贴的值（请记住这将复制每一行的输入 - 全部1,048,576 - 而不仅仅是你实际使用的那一行。如果您只想复制部分列，请不要使用.EntireColumn

不清楚Var1，Var2和Var3是什么，因为它们都以同一工作簿的名称结尾。虽然为每个赋值分配ActiveWorkbook.Name，但每个赋值之间没有任何更改活动工作簿，因此它们都获得相同的值

编辑：将.Columns(6).EntireColumn.Copy替换为.Range("F2:F55000").Copy，并将.Columns(9).EntireColumn.Copy替换为.Range("I2:I55000").Copy。还有其他更好的方法来实现这一目标，但这是最容易理解的。

您仍然需要确切地确定您认为自己要复制的工作簿。 sourceWB未在任何地方定义，其他三个变量都与同一工作簿相关。

应该这样：

'Open Source WorkBook
Application.Workbooks.Open (strPath)

而不是：

'Open Source WorkBook
Dim sourceWB As Workbook
Set sourceWB = Application.Workbooks.Open(strPath)

很难解释Var1和Var3的含义。唯一明显的用法是存储此宏的工作簿，但您可能打开其他工作簿，而这些工作簿在现有代码中未明确引用。如果它们打算与存储在其中的宏相关联，则：

'Give names to items
Dim Var1R As String
Var1R = "BT16"

Dim Var2R As Integer
Var2R = 1

Dim Var3R As String
Var3R = "BU16"

'Copy from Source to Target
sourceWB.Sheets(Var2R).Range("F2:F55000").Copy _
Destination:=ThisWorkbook.Sheets("PI-2 data").Range(VarR1)

sourceWB.Sheets(Var2R).Range("I2:I55000").Copy _
Destination:=ThisWorkbook.Sheets("PI-2 data").Range(Var3R)

'Close Source WorkBook wo/Save
sourceWB.Close False

超出范围错误将数据从一个工作簿复制到另一个工作簿

1 个答案: