打開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 

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