粘貼特殊方法奇數錯誤

Question

我已經通過類似的問題，並沒有發現這個具體的錯誤。

我試圖製作一個宏，它會經歷大量的CSV文件，提取我需要的必要信息，將這些數據複製並粘貼到新的工作簿中，然後關閉CSV文件並轉到下一個。

當我測試我的代碼並讓它一步一步運行（使用F8）時，它運行正常，沒有錯誤。但是，每當我嘗試並只運行代碼（如按F5）時，出現錯誤「類特徵的PasteSpecial方法」失敗。當我按調試這行代碼被高亮顯示： copyRange.Offset（0,1）.PasteSpecial粘貼：= xlPasteValues

我加了0.5s的一個小的時間延遲這一行之前，它實際上能去進一步通過失敗前的文件。

它是否與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

試試這個....

wbk2.sht2.Range("A1:A5").value = wbk1.sht1.Range("B1:B5").value