与多个用户共享的宏不会复制/粘贴到工作簿中

Posted 2023-03-27

【中文标题】与多个用户共享的宏不会复制/粘贴到工作簿中

【英文标题】：Macro shared with multiple users will not copy/paste into workbook

【发布时间】：2019-11-27 12:15:10

【问题描述】：

我和几位同事每两周根据导出的数据格式化报告。我想创建一个可以分发给每个人的宏，他们所做的只是在导出到本地计算机的数据上以尽可能少的步骤运行宏。我创建了一个宏，但我无法让它工作，因为目标工作簿（ThisWorkbook.Activesheet）是我的“PERSONAL.XLSB”（位于“XLSTART”文件夹并托管宏）而不是它需要的工作簿到（每个人每周都会改变）。主要问题是每当我运行宏时，“END_OF_REPORT.xlsx”中的数据将不会复制和粘贴，因为它正在尝试粘贴到“PERSONAL.XLSB”。

例如，我在位置 2，sally 是位置 3。我们都需要运行 1 月 1 日至 1 月 7 日的报告，因此将运行的文件（工作簿）对于我来说将是“jan1-jan7_1.xlsx” location 和 "jan1-jan7_2.xlsx" 表示 sally 的位置，两者都将仅包含 "Sheet1"。

当我打开 Visual Basic 时，打开的项目是“VBAProject (JAN1-JAN7_2.xlsx)”和“VBAProject (PERSONAL.XLSB)”，下面是模块 1、模块 2、Sheet1、ThisWorkbook。模块 1 用于位置 1，模块 2 用于位置 2。每当我尝试运行适当的宏时，它会执行所有操作，但会从我在宏中打开和关闭的工作簿中复制和粘贴数据。

Sub LOCATION_ONE_TRANS()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    
    Workbooks.Open "\\FILEPATH\END_OF_REPORT.xlsx"
       
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim CopyLastRow As Long
    Dim DestLastRow As Long
    
    'Replace 1 with appropriate location
    Set wsCopy = Workbooks("END_OF_REPORT.xlsx").Worksheets("1")
    Set wsDest = ThisWorkbook.ActiveSheet

    CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

    wsCopy.Range("A1:E" & CopyLastRow).Copy _
        wsDest.Range("A" & DestLastRow)
    Workbooks("END_OF_REPORT.xlsx").Close SaveChanges:=False

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range _
        ("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Cells.Select
    
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
...
...
    Dim rangeSelection As Range
    Dim cellCurrent As Range
 
    Set rangeSelection = Application.Selection.Columns(1).Cells
    ActiveSheet.ResetAllPageBreaks
 
    For Each cellCurrent In rangeSelection
        If (cellCurrent.Row > 1) Then
            If (cellCurrent.Value <> cellCurrent.Offset(-1, 0).Value) Then
                ActiveSheet.Rows(cellCurrent.Row).PageBreak = _
                    xlPageBreakManual
            End If
        End If
    Next cellCurrent
    Selection.RowHeight = 36.6
    Cells.EntireColumn.AutoFit
    Application.WindowState = xlMaximized
    ActiveWindow.Zoom = 50
    ActiveSheet.Range("A1").Select
    ActiveWorkbook.Save
    
End Sub

我应该与我的同事共享宏，这样他们只需要打开运行宏所需的工作簿，启用宏，因为他们将此宏保存到他们的“XLSTART”，然后运行宏.实际发生的情况是，当任何人运行宏时，工作表正在格式化，但复制/粘贴的数据没有进入正确的工作簿（即 JAN1-JAN7_2.xlsx）

【参考方案1】：

ThisWorkbook 总是指代码所在的文件。这就是为什么Set wsDest = ThisWorkbook.ActiveSheet 行会将您的 Personal.xlsb 设置为目的地。