我在userform中有一些vba代码,根据userform的条件打开一堆包含一行代码的工作表。然后,它应该将数据复制到另一个工作簿中的表中。 它在调试时正常工作,但在播放时它管理大约30行,然后崩溃并重新启动excel。
以下代码......
Option Explicit
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Run_Click()
Dim lastrow As Integer
Dim n As Integer
Dim i As Integer
Dim file As Variant
Dim wo As String
Dim wb As String
Dim openwb As String
Dim r As Integer
Dim c As Integer
Dim x As Integer
Dim oFS As Object
Dim strFilename As String
If ListBox1.Value <> "" Then
wo = ListBox1.Value
Workbooks.Add
wb = ActiveWorkbook.Name
file = Dir("\\hlepcs01\Runtime_CMM\Gauging\mast_dat\SmartWall\")
Set oFS = CreateObject("Scripting.FileSystemObject")
n = 2
x = 1
While (file <> "")
If InStr(Left(file, 4), wo) > 0 Then
Workbooks("Smartwall Data Collate.xlsm").Sheets("Datasheet").Range("C" & n).Value = file
n = n + 1
End If
file = Dir
Wend
For i = 2 To (n - 2)
openwb = Workbooks("Smartwall Data Collate.xlsm").Sheets("Datasheet").Range("C" & i).Value
Workbooks.Open ("\\hlepcs01\Runtime_CMM\Gauging\mast_dat\SmartWall\" & openwb)
r = 1
c = 1
Do Until Cells(r, c).Value = ""
If Cells(r, c).Value <> "" Then
c = c + 1
End If
Loop
If c <= 1 Then
GoTo 1
End If
Workbooks(openwb).Activate
Application.CutCopyMode = False
Range(Cells(1, 1), Cells(1, (c - 2))).Copy
Workbooks(wb).Activate
Range("C" & x).PasteSpecial xlPasteValues
Workbooks(openwb).Activate
Application.CutCopyMode = False
Cells(1, (c - 1)).Copy
Workbooks(wb).Activate
Range("B" & x).PasteSpecial xlPasteValues
Range("A" & x).Value = oFS.GetFile("\\hlepcs01\Runtime_CMM\Gauging\mast_dat\SmartWall\" & openwb).DateCreated
x = x + 1
1
Workbooks(openwb).Close
Next
Workbooks("Smartwall Data Collate.xlsm").Sheets("Datasheet").Range("C2:C" & (n - 2)).ClearContents
If n <= 2 Then
Workbooks(wb).Close , xlNo
MsgBox "No Data Found"
End If
Unload Me
Else
MsgBox "No Works Order Selected"
Exit Sub
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
Dim lastrow As Integer
lastrow = Workbooks("Smartwall Data Collate.xlsm").Sheets("Datasheet").Range("A1").End(xlDown).Row
For i = 2 To lastrow
With ListBox1
.AddItem Workbooks("Smartwall Data Collate.xlsm").Sheets("Datasheet").Range("A" & i).Value
End With
Next
End Sub