PasteSpecial रेंज वर्ग विफल, मैं बेहतर क्या कर सकता हूं?

Question

मैं एक पुस्तक से एक श्रृंखला की प्रतिलिपि बनाने की कोशिश कर रहा हूं, लक्ष्य पुस्तक खोलें और मानों को उस शीट पर संलग्न करें, रेंज क्लास की विफलता प्राप्त कर रहा है और यह निश्चित नहीं है कि इसे कैसे ठीक किया जाए। यहाँ मेरा कोड है, देखने के लिए धन्यवाद।

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

किसी भी सुझाव या मदद की बहुत सराहना की है, धन्यवाद।

Comments

कार्यपुस्तिका को बंद करना / दूसरा खोलना क्लिपबोर्ड / सेटिंग CutCopyModeको साफ़ करने की संभावना है False। स्रोत पुस्तक को खुला रखने का प्रयास करें और .Copy तुरंत पहले चलाएं .PasteSpecial। जैसा कि आप बेहतर कर सकते हैं, एक बार आपके पास कोड होता है जो कि उद्देश्य के रूप में काम करता है जो कोड समीक्षा के लिए एक प्रश्न बन जाता है ।

— मैथ्यू गुइंडन

मैं कार्यपुस्तिका को खुला नहीं छोड़ सकता क्योंकि यह पूरी तरह से चलने पर 400 के आसपास खुल जाएगी। क्या स्रोत बुक में वापस जाने और मूल्यों को चिपकाने के बाद इसे बंद करने का कोई तरीका है ताकि मैं अपने कंप्यूटर को क्रैश न करूं?

— वर्किनटवर्क

मैंने यह नहीं कहा कि इसे हमेशा के लिए खुला छोड़ दें , मैंने कहा कि इसे तब तक खुला छोड़ दें जब तक आप पेस्ट न करें - बेशक आपको इसे बंद कर देना चाहिए!

— मथिउ गुइंडन

Answer 1

जैसा कि @ MatMug द्वारा उल्लेख किया गया है, आप उस फ़ाइल को बंद कर रहे हैं जिसे आपने बहुत पहले कॉपी किया था, जिसके कारण त्रुटि हुई।

और बड़ा मुद्दा यह है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