将一系列单元格从工作簿复制到我在代码中创建的工作簿时,应用程序定义了错误

时间:2013-04-18 12:44:23

标签: excel excel-vba excel-2007 vba

我在星号线上得到了错误。我浏览了很多,我发现许多答案我复制相同,但仍然得到这个错误。我不确定我在做什么错。

请帮忙。提前谢谢。

Sub splitIntoCsv()
    Dim wbIn
    Dim wbIn1 As Workbook
    Dim header, ranges, range_lower, range_upper, rangeCopy As Variant
    Dim rangeVariable As String
    Dim commacheck, rows, columns As Integer

    Set wbIn = CreateObject("Excel.Application")
    wbIn.Workbooks.Add
    wbIn.Worksheets(1).Name = "TestData"
    Set wbIn1 = Workbooks.Open(Sheet1.Range("B1").Value, True, True)

    rows = wbIn1.Sheets(1).UsedRange.rows.Count
    columns = wbIn1.Sheets(1).UsedRange.columns.Count
    header = Split(ThisWorkbook.Sheets(1).Range("B2").Value, ",")
    rangeVariable = ThisWorkbook.Sheets(1).Range("B3").Value
    commacheck = InStr(rangeVariable, ",")

    If commacheck = 0 Then
        rangeVariable = rangeVariable & ","
    End If

    ranges = Split(rangeVariable, ",")
    For i = LBound(ranges) To UBound(ranges) - 1
        For j = LBound(header) To UBound(header)
            wbIn.Worksheets(1).Cells(1, j + 1).Value = header(j)
        Next j

        range_lower = Split(ranges(i), "-")(0)
        range_upper = Split(ranges(i), "-")(1)

        With wbIn1.Sheets(1)
           rangeCopy = .Range(.Cells(1 + range_lower, 1), .Cells(1 + range_upper, columns)).Value
        End With

        With wbIn.Worksheets(1)  
          *********        
            .Range(.Cells(1 + range_lower, 1), .Cells(1 + range_upper, columns)).Value = rangeCopy
          *********
        End With

    Next i

    wbIn1.Close SaveChanges:=True

    wbIn.DisplayAlerts = False
    wbIn.Worksheets(1).SaveAs Filename:="D:\RaghuDev\raghu.csv", FileFormat:=xlCSV, CreateBackup:=False
    wbIn.Quit        
End Sub

1 个答案:

答案 0 :(得分:0)

我没有得到相同的错误,但您可以在新的Excel报告中尝试以下测试吗?我试图重建你问题的关键领域。

请务必输入一些样本数据,然后选择1到3的范围。

Sub test()

    Dim wbIn
    Set wbIn = CreateObject("Excel.Application")
    wbIn.Workbooks.Add
    wbIn.Worksheets(1).Name = "TestData"

    Dim r As Variant, columns As Integer

    r = Selection.Value
    columns = 3

    With wbIn.Worksheets(1)
        .Range(.Cells(1, 1), .Cells(1, columns)).Value = r
    End With

End Sub

还尝试定义变体:

ReDim rangeCopy(1 to (range_upper - range_lower + 1), 1 to columns) as Variant

With wbIn1.Sheets(1)
   rangeCopy = .Range(.Cells(1 + range_lower, 1), .Cells(1 + range_upper, columns)).Value
End With

With wbIn.Worksheets(1)  
    .Range(.Cells(1 + range_lower, 1), .Cells(1 + range_upper, columns)).Value = rangeCopy
End With