我正在尝试从一本书中复制一个范围,打开目标书并将值附加到该工作表,但出现 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
非常感谢任何建议或帮助,谢谢。
答案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