VBA:下标超出范围

时间:2014-08-14 16:26:10

标签: excel vba excel-vba

已经问过类似的问题,但我认为我有一个不同的问题:

 Workbooks.Open Filename:=filepath & "PLT.xlsx"

Worksheets("Sheet1").Range(Worksheets("Sheet1").Range("A1:B1"), Worksheets("Sheet1").Range("A1:B1").End(xlDown)).Copy
Windows("XXX.xslm").Activate
w1.Range("A4").PasteSpecial Paste:=xlPasteValues

第二行是问题所在。事实上,它不会复制我想要的细胞。当我打开该工作簿时,将选择整个工作表。

我不明白为什么会收到这个错误。

1 个答案:

答案 0 :(得分:1)

让人惊讶。如果您想以简单的方式复制值:

Global fso As New FileSystemObject

Public Sub CopyValuesTest()

    ' Get references to the files
    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = Workbooks.Open(fso.BuildPath(filepath, "PLT.xlsx"))
    Set wb2 = Workbooks("XXX")

    ' Get references to the sheets
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb1.Sheets("Sheet1")
    Set ws2 = wb2.Sheets("Sheet1")

    ' Count non-empty rows under A1. Use 2 columns
    Dim N As Integer, M As Integer
    N = CountRows(ws1.Range("A1")): M = 2

    ' This copies the values
    ws2.Range("A4").Resize(N, M).Value = ws1.Range("A1").Resize(N, M).Value
End Sub

Public Function CountRows(ByRef r As Range) As Long
    If IsEmpty(r) Then
        CountRows = 0
    ElseIf IsEmpty(r.Offset(1, 0)) Then
        CountRows = 1
    Else
        CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
    End If
End Function

确保定义了filepath。另外要使用FileSystemObject,请参阅https://stackoverflow.com/a/5798392/380384