运行时Vba崩溃,在调试中正常工作

时间:2018-06-11 14:20:26

标签: excel vba excel-vba

我在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

0 个答案:

没有答案