Question

我正在慢慢地在Excel中学习VBA，所以我确信这段代码可以被选中。基本上，用户使用信息填充此区域，然后单击一个按钮，在后台复制他们填充的数据，打开一个新工作簿并将其粘贴到下一个打开的行中。有许多用户，对于一些用户来说，对于其他用户来说，它运行时没有错误但是他们的信息没有粘贴在新用户中。地点。最后的大部分内容都只是重新格式化，但我并不想把它拿出去以防它成为问题的一部分。

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:    IsWorkBookOpen = False
        Case 70:   IsWorkBookOpen = True
        Case Else: Error ErrNo
    End Select
End Function


Sub FF_Temp_Upload()
'
' FF_Temp_Upload Macro
'
    Application.ScreenUpdating = False
    Dim Workbk As Workbook
    Set Workbk = ThisWorkbook
    Dim LR As Long
    Dim Cell As Long
    Dim Ret As String

    LR = Range("B" & Rows.Count).End(xlUp).Row
    Ret = IsWorkBookOpen("Location of the 2nd workbook/OVS Upload Template.xlsx")


    If Ret = True Then
        MsgBox "Template is currently being updated elsewhere. Please try again."
        Exit Sub
    Else
        Workbooks.Open FileName:= _
    "Location of the 2nd workbook/OVS Upload Template.xlsx"    
    End If

    Workbk.Activate
    Range("A2:C" & LR).Select
    Selection.Copy
    Windows("OVS Upload Template.xlsx").Activate

    If Range("A2") = "" Then
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    Else
        Range("A1").Select
        Selection.End(xlDown).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    End If

    Workbk.Activate
    Range("H2:H" & LR).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("OVS Upload Template.xlsx").Activate

    If Range("L2") = "" Then
        Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    Else
        Range("L2").Select
        Selection.End(xlDown).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    End If

    ActiveSheet.Range("$A$1:$M$100000").RemoveDuplicates Columns:=1, Header:=xlYes

    LR = Range("B" & Rows.Count).End(xlUp).Row
    Range("B2:B" & LR) = "=text(left(A2,8),""00000000"")"
    Range("B2:B" & LR).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C2:C" & LR) = "=""DCG""&MID(A2,9,4)"
    Range("C2:C" & LR).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("D2:D" & LR).Select
    Selection.Formula = "DT"
    Range("I2:I" & LR).Select
    Selection.Formula = "730"
    Range("M2:M" & LR).Select
    Selection.Formula = "MAJOH73"


    ActiveWorkbook.Save
    ActiveWindow.Close
    Workbk.Activate

    MsgBox "Articles Uploaded"
End Sub

Answer 1

您未在代码中的任何位置引用Worksheets。因此，对于某些用户来说，它是有效的，有些则不然。

对于那些工作的人 - 他们的Excel文件保存时选择了正确的工作表。

对于那些不工作的人 - 他们的Excel文件保存时选择了错误的工作表。因此，当它打开时，ActiveSheet是错误的，代码在那里工作。

要修复它（快速和脏）重写代码，请像这样引用工作表：

Worksheets("MyWorksheet").Range("$A$1:$M$100000").RemoveDuplicates Columns:=1

然后尽量避免Selection和ActiveSheet - How to avoid using Select in Excel VBA。最后，每个范围或单元格应该与引用的工作表一起使用。像这样：

With Worksheets("MyName")
    .Range("D2:D" & LR).Formula = "DT"
    .Range("I2:I" & LR).Formula = "730"
    .Range("M2:M" & LR).Formula = "MAJOH73"
End With

宏从一个工作簿复制到另一个工作簿，运行没有错误，但有时不起作用

1 个答案: