La classe PasteSpecial Range échoue, que puis-je améliorer?

J'essaie de copier une plage d'un livre, d'ouvrir le livre cible et d'ajouter les valeurs à cette feuille, en obtenant un échec de la classe Range sans savoir comment résoudre ce problème. Voici mon code, merci de regarder.

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

Toute astuce ou aide est grandement appréciée, merci.

microsoft-excel vba

— Workinatwork
source

Fermer le classeur / en ouvrir un autre est probablement en train de vider le presse-papiers / le paramètre CutCopyMode à False. Essayez de garder le livre source ouvert et lancez le .Copy immédiatement avant le .PasteSpecial. Quant à ce que vous pourriez faire de mieux, une fois que vous avez un code qui fonctionne comme prévu, il devient une question pour Examen du code .

— Mathieu Guindon

Je ne peux pas laisser le classeur ouvert, car il finira par en ouvrir environ 400 s'il est complètement traversé. Existe-t-il un moyen de revenir au livre source et de le fermer après avoir collé les valeurs afin que je ne plante pas mon ordinateur?

— Workinatwork

Je n'ai pas dit laissez-le ouvert pour toujours , J'ai dit laissez-le ouvert jusqu'à ce que vous colliez - Bien sûr, vous devriez le fermer après!

— Mathieu Guindon

Comme mentionné par @ Mat'sMug, vous fermiez trop tôt le fichier que vous avez copié, ce qui a provoqué l'erreur mentionnée.

Et le plus gros problème est Len(strFile) > 0 parce que vous avez déjà assigné le chemin du dossier dans strFiledonc ce ne sera jamais 0 et vous resterez coincé dans votre boucle pour toujours.

Voici votre code corrigé et amélioré:

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

— R3uK
source