Question

我已经完成了类似的问题，但没有找到任何有关此特定错误的内容。

我正在尝试创建一个遍历大量CSV文件的宏，提取我需要的必要信息，将该数据复制并粘贴到新工作簿，然后关闭CSV文件并转到下一个文件。

当我测试我的代码并让它逐步运行（使用F8）时，它运行正常并且没有错误。但是，每当我尝试运行代码时（例如按下F5），我就会得到错误＆＃34;类别范围的粘贴特殊方法＆＃34;失败。当我按下调试时，这行代码突出显示： copyRange.Offset（0,1）.PasteSpecial Paste：= xlPasteValues

我在此行之前添加了0.5秒的小时间延迟，它实际上能够在失败之前进一步浏览文件。

是否属于Range.Offset方法？我应该明确定义不同的复制范围吗？

我的代码如下：

Public Sub OpenTXT_CopyNewWBK(inPath As String)
    Application.ScreenUpdating = False
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection
    Dim app As New Excel.Application
    app.Visible = True
    Dim dataRange As Range, dateRange As Range, copyRange As Range
    Dim lastCell, lastRow As String
    Dim newBook, wbk As Excel.Workbook
    Dim csvStart As Long
    Set newBook = Workbooks.Add
    With newBook
        .SaveAs Filename:="BETA RAY " & Format(Now, "ddmmyyhhmmss")
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(inPath) 'obviously replace
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder 'enqueue
        Next oSubfolder
        For Each oFile In oFolder.Files
            Set wbk = app.Workbooks.Add(oFile.Path)
            lastCell = wbk.Sheets(1).Range("A1").End(xlDown).Address
            If Len(lastCell) = 6 Then
                lastRow = Mid(lastCell, 4, 3)
            ElseIf Len(lastCell) = 5 Then
                lastRow = Mid(lastCell, 4, 2)
            ElseIf Len(lastCell) = 4 Then
                lastRow = Mid(lastCell, 4, 1)
            End If
            Set dateRange = wbk.Sheets(1).Range("A2", lastCell)
                dateRange.Select
            Set dataRange = wbk.Sheets(1).Range("AA2", "AM" & lastRow)
                dataRange.Select
            wbk.Application.CutCopyMode = True
            Set copyRange = Workbooks(newBook.name).Sheets(1).Range("A1048576").End(xlUp)
            If Not copyRange = "" Then
                Set copyRange = copyRange.Offset(1, 0)
            End If
            dateRange.Copy
            copyRange.PasteSpecial Paste:=xlPasteValues
            wbk.Application.CutCopyMode = False
            wbk.Application.CutCopyMode = True
            Application.Wait (Now + 500 * 0.00000001)
            dataRange.Copy
            copyRange.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
            wbk.Application.CutCopyMode = False
            wbk.Close SaveChanges:=False
        Next oFile
    Loop
    app.Quit
    Set app = Nothing
    Range("B:B").Delete
    Range("G:G").Delete
    Range("L:L").Delete
    Application.ScreenUpdating = True
End Sub

我相信有很多方法可以做很多我在那里做的事情。我真的只是使用VBA让我的工作变得更轻松，所以我使用的很多代码都是复制，粘贴和修改以满足我的需求。我无法弄清楚如何让这个方法有效wbk2.sht2.Range("A1:A5") = wbk1.sht1.Range("B1:B5")我读到的一切都说这应该是一个更好的方法。此外，阅读dataRange.Select和dateRange.Select的代码部分仅用于调试目的。

Answer 1

试试这个......

var p3 = Person(name: "OOO")

PasteSpecial Method奇怪错误

1 个答案: