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

Question

我无法将复制的范围粘贴到目标工作簿中。我有一个 .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

更新2：

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