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