下标超出范围VBA复制到csv

在写一段代码时，我遇到了“下标超出范围”的信息。

该文件夹的结构如下：D：\ Documents主目录里面它有：xls工作簿与代码一个文件1.csv我需要复制数据文件夹WiP其中包含csv文件与数据

代码目前看起来像这样

Sub MergeData() ' ' Ìàêðîñ1 Ìàêðîñ ' Provide path to workbooks, ' there is a folder with about 100 csv books from which I should collect data into one Dim Filename, Pathname As String Dim wb As Workbook Pathname = ActiveWorkbook.Path & "\WiP\" Filename = Dir(Pathname & "*.csv") ' Open a workbook in which the data should be pasted Workbooks.Open ("D:\Documents\1.csv") ActiveSheet.Cells(1, 1).Value = "date" ActiveSheet.Cells(1, 2).Value = "hour" ActiveSheet.Cells(1, 3).Value = "num" ActiveSheet.Cells(1, 4).Value = "p" ' Call the code Do While Filename <> "" Set wb = Workbooks.Open(Pathname & Filename) IntegrateDays wb wb.Close savechanges:=False Filename = Dir() Loop ' Close the workbook with data Workbooks("D:\Documents\1.csv").Close savechanges:=True End Sub Sub IntegrateDays(wb As Workbook) Dim ws As Worksheet With wb ' Open workbooks, copy a range Sheets(1).Activate Dim rng As Range Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown)) rng.Copy ' Paste the range into 1.csv Workbooks("D:\Documents\1.csv").Worksheets(1).Range("B" & Worksheets(1).UsedRange.Rows.Count + 1).Activate rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing End With End Sub 

代码会一直运行，直到它将复制的范围rng粘贴到1.csv并停止并出现错误。 第一个猜测是，这可能是一个与range.activate有关的错误。 我试图通过没有循环的操作来进行testing，只select一个单元，然后在甚至select任何范围之前打开1.csv。 错误依然存在。 第二个怀疑是有一个问题打开1.csv。 通过查看诸如“下标超出范围的开放式CSV”的search，我没有发现任何可以帮助解决这个问题的深入讨论的问题。

你能不能请告诉我是什么导致了错误，以及如何重写代码？

非常感谢你提前。

叶夫根尼娅。

Answer 1

你不应该使用rng.PasteSpecial 。 Range.PasteSpecial方法的父级应该是目的地; 不是来源。

既然你有兴趣获得价值，放弃PasteSpecial有利于直接价值转移。

 Dim rng As Range with Sheets(1) Set rng = .Range(Cells(1, 1), Cells(1, 1).End(xlDown)) end with with Workbooks("D:\Documents\1.csv").Worksheets(1) .cells(rows.count, "B").end(xlup).offset(1,0).resize(rng.rows.count, rng.columns.count) = rng.Value end with 

Answer 2

你是否试图从工作簿复制到其他人？ 尝试调整这一点

 Application.ScreenUpdating = False Columns("A:C").Sort Key1:=Range("C2"), _ Order1:=xlDescending, Header:=xlYes Application.ScreenUpdating = True Dim WBookCopy As Workbook Dim WBookPst As Workbook Dim Filepath As String Dim SheetName As String Dim sheetCopy As Worksheet Set WBookPst = Application.ActiveWorkbook Call DeleteCache 'B2 is the location directory of latest Excel file Filepath = Range("B2").Value Set WBookCopy = Workbooks.Open(Filepath) Set sheetPst = WBookPst.Worksheets(2) Set sheetCopy = WBookCopy.Worksheets(1) sheetCopy.UsedRange.Copy sheetPst.Range("A:AG") sheetCopy.UsedRange.Value = sheetCopy.UsedRange.Value WBookCopy.Close (False)