A classe PasteSpecial Range falha, o que posso fazer melhor?

Question

Eu estou tentando copiar um intervalo de um livro, abrir o livro de destino e acrescentar os valores a essa folha, obtendo uma falha na classe Range e não sei como consertar isso. Aqui está o meu código, obrigado por procurar.

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

Qualquer dica ou ajuda é muito apreciada, obrigado.

    

Answer 1

Como mencionado por @ Mat'sMug, você estava fechando o arquivo que você copiou muito cedo, causando o erro mencionado.

E o problema maior é Len(strFile) > 0 porque você já atribuiu o caminho da pasta em strFile , por isso nunca será 0 e você ficará preso no seu loop para sempre .

Aqui está o seu código corrigido e melhorado:

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