打开CSV，将粘贴范围复制到工作簿

我无法将复制的范围粘贴到目标工作簿中。 我有一个.csv文件，将有一个工作表，但每次导出.csv工作表名称将会不同。 有人可以看看我的代码，让我知道，如果你看到任何突出的东西，将会搞砸了。

代码运行到Target.Copy （目标范围被选中并复制）。 但是我必须将这些值粘贴到目标工作簿的代码似乎没有工作。

我有时会得到这个错误信息：

 Sub Opencsv() Dim FilesToOpen Dim wkbTemp As Workbook, wkbDest As Workbook Dim sh As Worksheet Dim Last As Long Dim Target As Range Dim LastRow As Long, LastCol As Long FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open") On Error Resume Next Last = fLastRow(wkbDest) Set wkbTemp = Workbooks.Open(filename:=FilesToOpen, Format:=4) Set wkbDest = ThisWorkbook.Worksheets("AdvFilter") With wkbTemp.Sheets(1) LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)) End With Target.Copy wkbDest.Sheets("AdvFilter").Activate With wkbDest.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With wkbTemp.Close End Sub '================== Function fLastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function 

UPDATE2：

 Sub Opencsv2() Dim FilesToOpen Dim qt As QueryTable Dim Last As Long FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open") With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & FilesToOpen, Destination:=Cells(Last + 1, "A")) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With For Each qt In ThisWorkbook.Sheets("AdvFilter").QueryTables qt.Delete Next qt End Sub 

Answer 1

考虑导入使用QueryTables，并避免任何复制/粘贴到剪贴板：

 Sub Opencsv() Dim FilesToOpen Dim qt As QueryTable FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open") With ThisWorkbook.Sheets("AdvFilter").QueryTables.Add(Connection:="TEXT;" & FilesToOpen, _ Destination:=Cells(1, 1)) .TextFileStartRow = 30 .TextFileParseType = xlDelimited .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .Refresh BackgroundQuery:=False End With For Each qt In ThisWorkbook.Sheets("AdvFilter").QueryTables qt.Delete Next qt End Sub