Класс PasteSpecial Range не работает, что я могу сделать лучше?

Question

Я пытаюсь скопировать диапазон из одной книги, открыть целевую книгу и добавить значения к этому листу, получая ошибку класса Range и не зная, как это исправить. Вот мой код, спасибо за поиск.

Sub openDATfiles()

' openDATfiles Macro

Dim ws As Worksheet, strFile As String, x As Integer, _
y As Long, Pressure As Variant, Tstamp As Variant, LastRow As Long, LastRow2 As Long, cn As Variant, fPath As String

fPath = "F:\McMAHON\From David\SJ15_10_01_CD\"
strFile = fPath & Dir(fPath & "*.dat")
x = 1
y = 1

' Start Loop 1

Do While Len(strFile) > 0

Workbooks.OpenText FileName:= _
    strFile, Origin:=437, StartRow _
    :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True _
    , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
    Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
    Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True

Set ws = ActiveSheet


   Do Until x = 31

    Pressure = WorksheetFunction.Max(Range("J" & y + 4 & ":J" & y + 1203))
    Tstamp = WorksheetFunction.Max(Range("A" & y + 4 & ":A" & y + 1203))

        x = x + 1
        y = y + 1201

        LastRow = ws.Range("N" & Rows.Count).End(xlUp).Row + 1

    ws.Range("O" & LastRow).Value = Pressure
    ws.Range("N" & LastRow).Value = Tstamp



Loop

     strFile = fPath & Dir

Range("A1:K36004").delete Shift:=xlUp

Range("N2:O31").Copy

ActiveWorkbook.Close savechanges:=False




Dim Pastebook As Workbook

'## Open both workbooks first:
Set Pastebook = Workbooks.Open("F:\McMAHON\Useful Things\VBA\PiezoData")

LastRow2 = ActiveWorkbook.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1

'Now, paste to y worksheet:
Pastebook.Sheets("sheet1").Range("A" & LastRow2).PasteSpecial xlPasteValues


Loop

End Sub

Любые советы или помощь с благодарностью, спасибо.

Answer 1

Как упомянул @ Mat'sMug, вы слишком рано закрыли скопированный файл, что вызвало указанную ошибку.

И большая проблема - Len(strFile) > 0 потому что вы уже указали путь к папке в strFile , поэтому он никогда не будет равен 0, и вы навсегда останетесь в цикле.

Вот ваш код исправлен и улучшен:

Sub openDATfiles()
'''openDATfiles Macro
Dim wS As Worksheet, strFile As String, x As Integer, _
y As Long, Pressure As Variant, Tstamp As Variant, cn As Variant

Dim FolderPath As String, FileName As String, FilePath As String
Dim wB As Workbook, PasteBook As Workbook, PasteSheet As Worksheet
Dim NextRow As Long, NextPasteRow As Long

FolderPath = "F:\McMAHON\From David\SJ15_10_01_CD\"
'''Start Loop 1
x = 1
y = 1

'''Open destination workbook first
Set PasteBook = Workbooks.Open("F:\McMAHON\Useful Things\VBA\PiezoData")
Set PasteSheet = PasteBook.Sheets("Sheet1")

FileName = Dir(FolderPath & "*.dat")
Do While FileName <> vbNullString
    FilePath = FolderPath & FileName
    se wB = Workbooks.OpenText( _
                    FileName:=FilePath, _
                    Origin:=437, _
                    StartRow:=1, _
                    DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, _
                    Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
                    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
                        Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), _
                    TrailingMinusNumbers:=True _
                    )
    DoEvents
    Set wS = wB.Sheets(1)
    With wS
        Do Until x = 31
            Pressure = WorksheetFunction.Max(.Range("J" & y + 4 & ":J" & y + 1203))
            Tstamp = WorksheetFunction.Max(.Range("A" & y + 4 & ":A" & y + 1203))
            x = x + 1
            y = y + 1201
            NextRow = .Range("N" & .Rows.Count).End(xlUp).Row + 1
            .Range("O" & NextRow).Value = Pressure
            .Range("N" & NextRow).Value = Tstamp
        Loop
        .Range("N2:O31").Copy
    End With 'wS

    With PasteSheet
        NextPasteRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        '''Now, paste to your pastesheet
        .Range("A" & NextPasteRow).PasteSpecial xlPasteValues
    End With 'PasteSheet

    '''Pasting done : you can close the file you copied from
    wB.Close savechanges:=False
    '''Get next file name
    FileName = Dir()
Loop

End Sub