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

时间:2014-03-13 17:00:40

标签: excel vba excel-vba

Sub FileFromClosedWorkbook()

    'Assign variable name to Target workbook
    Var1 = ActiveWorkbook.Name
    'Assign variable name to Target range
    Var1R = "A1:I50000"

    'Open Source WorkBook
    Application.Workbooks.Open ("S:\private")

    'Assign variable name to Source workbook
    Var2 = ActiveWorkbook.Name
    Var2R = "private"

    'Copy from Source to Target
    Sheets(Var2R).Columns("A:H").EntireColumn.Copy _
    Destination:=Workbooks(Var1).Sheets("Data").Range(Var1R)
    'Close Source WorkBook wo/Save
    Workbooks(Var2).Close False

End Sub

'This button will create the metrics within the workbook
Sub CreateMetrics()
    'Open redeacted data sheet
    'Workbooks.Open Filename:= _
    "S:\private"
    'Sheets("Data").Activate
    'Select and paste all into this workbook

    'Cells.Select
    'Range("A65536").Activate
    'Selection.Copy
    'Sheets("Data").Select
    'Cells(1, 1).PasteSpecial xlPasteAll

    'Go to very last cell with data in it
    'Store this value
    Dim ending As Range
    Set ending = Range("A65536").End(xlUp).Select
    'Subtract 250, this is because the data has an issue graphing with more values than this
    Dim beginning As Range
    beginning = Range(ending - 250)
    'Choose the sheet
    Sheets("Chart").Activate
    'Create a scatter plot in the next sheet
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatter
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 2").IncrementLeft -282.75
    ActiveSheet.Shapes("Chart 2").IncrementTop -184.5
    ActiveSheet.Shapes("Chart 2").ScaleWidth 2.4333333333, msoFalse, _
    msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 2").ScaleHeight 2.5677085156, msoFalse, _
    msoScaleFromTopLeft
    'Name first series
    'Choose data (last 250 pts) for y-axis
    'Move date into a new column and convert to a number, this is because the date has trouble plotting itself on the x-axis
    'Choose data (last 250 pts) for x-axis
    'Edit axis options, fixed min & max (values as the converted values of the date), major unit of 3
    'Set number as a date and format
    'Rotate the text 90 degrees
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=Sheet2!$G$1"
    ActiveChart.SeriesCollection(1).XValues = "=Sheet2!$B$75:$B$318"
    ActiveChart.SeriesCollection(1).Values = "=Sheet2!$D$75:$D$318"
    ActiveChart.PlotArea.Select
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).MinimumScale = 41300
    ActiveChart.Axes(xlCategory).MaximumScale = 42000
    ActiveChart.Axes(xlCategory).MajorUnit = 100
    ActiveChart.Axes(xlCategory).MajorUnit = 3
    ActiveChart.Axes(xlCategory).MinimumScale = 41643.2
    ActiveChart.Axes(xlCategory).MaximumScale = 41705.04
    Selection.TickLabels.NumberFormat = "m/d/yyyy"
    Selection.TickLabels.NumberFormat = "m/d/yy;@"
    Selection.TickLabels.NumberFormat = "mm/dd/yy;@"
    ActiveChart.PlotArea.Select
    Selection.Height = 449.495
    'Repeat for private and private
    Sheets("private").Activate
    Sheets("private").Activate
End Sub

大家好,我正在尝试将数据从一个工作簿复制到另一个工作簿,因此我可以根据这些数据创建图表/指标,这给我带来了很多麻烦。这个代码只是在网上或通过宏录制器一起制作,我试图逐行完成并修复它直到它工作。当我在我的S驱动器中打开我的文件后逐行调试它时,它给了我一个超出范围的错误(根据我从它获得的论坛,它应该在不打开文件的情况下获取文件)。造成这种情况的原因是什么?

我是VBA /编程的新手,所以请原谅我的无知。此外,我更改了大多数变量名称/一些评论,因为这是与工作相关的。 Excel 2010如果相关。

谢谢!

1 个答案:

答案 0 :(得分:0)

试试这个(只修改了一下你的代码):

Sub FileFromClosedWorkbook()

    Dim Var1 As String, Var1R As String
    'Assign variable name to Target workbook
    Var1 = ActiveWorkbook.Name
    'Assign variable name to Target range
    Var1R = "A1:I50000"

    'Open Source WorkBook
    Application.Workbooks.Open ("S:\Lab Data.xslxm")

    Dim Var2 As String, Var2R As String
    'Assign variable name to Source workbook
    Var2 = ActiveWorkbook.Name
    Var2R = "Chemical"

    'Copy from Source to Target
    Workbooks(Var2).Sheets(Var2R).Columns("A:H").EntireColumn.Copy _
    Destination:=Workbooks(Var1).Sheets("Data").Range(Var1R)
    'Close Source WorkBook wo/Save
    Workbooks(Var2).Close False

End Sub

或者我发现它更健壮:

Sub FileFromClosedWorkbook()

    Dim Var1 As String, Var1R As String
    'Assign variable name to Target workbook
    Var1 = ActiveWorkbook.Name
    'Assign variable name to Target range
    Var1R = "A1:I50000"

    Dim sourceWB As Workbook
    'Open Source WorkBook
    Set sourceWB = Application.Workbooks.Open("S:\Lab Data.xslxm")

    Dim Var2R As String
    'Assign variable name to Source workbook
    Var2R = "Chemical"

    'Copy from Source to Target
    sourceWB.Sheets(Var2R).Columns("A:H").EntireColumn.Copy _
    Destination:=Workbooks(Var1).Sheets("Data").Range(Var1R)
    'Close Source WorkBook wo/Save
    sourceWB.Close False

End Sub