CSVを開き、貼り付け範囲をブックにコピー

Question

コピー先のブックを貼り付けるのに問題があります。 1つのワークシートを持つ.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