为什么此Excel宏在计算机上而不在另一台计算机上有效?

时间:2018-11-26 21:40:53

标签: excel vba

我知道我的代码看起来像科学怪人(Frankenstein),可以在网络上使用,但是它确实可以在我的计算机上工作。但是,当我尝试在另一台计算机(具有相同的Excel 2016版本)上运行它时,它会给我

  

运行时错误'9':订阅超出范围

为什么?

我一直在进行一些迭代,例如删除activeworkbook来处理它给出的各种错误,但是错误一直在变化。另外,这次,VBA调试器甚至没有给我黄线检查。

Sub CombineAll()

    'Stop, delete sheet and activate Alerts
    Application.DisplayAlerts = False
    Sheets("Programmation générale").Delete
    Application.DisplayAlerts = True

    'Insert a new worksheet. Assign it to a name. Place it before Index
    Set NewWs = Worksheets.Add(Before:=Worksheets("Index"))
    NewWs.Name = "Programmation générale"

    'Loop to copy worksheets
    NextRow = 1
    For Each ws In ThisWorkbook.Worksheets
        If Not NewWs.Name = ws.Name Then
            If Not Sheet1.Name = ws.Name Then
                finalRow = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
                ws.Cells(2, 1).Resize(finalRow, 14).Copy NewWs.Cells(NextRow, 1)
                NextRow = NextRow + finalRow
            End If
        End If
    Next ws

    'Copy header
    Sheet3.Range("A1:N1").Copy
    NewWs.Range("A1").Rows("1:1").Insert Shift:=xlDown


    'Select the new worksheet and transform into table
    NewWs.Select
    Dim src As Range
    Set src = Range("B5").CurrentRegion
    Set NewWs = ActiveSheet
    NewWs.ListObjects.Add(SourceType:=xlSrcRange, Source:=src, _
    xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium15").Name = "ProgrammationGenerale"

    'Arrange the table to specifications
    Range("ProgrammationGenerale[#All]").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    ActiveSheet.Columns("A:N").AutoFit

    Dim finalRowTable As Integer
    Dim i As Integer
    finalRowTable = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:A" & finalRow).EntireRow.AutoFit
    For i = 2 To finalRow
        If Range("A" & i).EntireRow.RowHeight < 27 Then
            Range("A" & i).EntireRow.RowHeight = 27
        End If
    Next if

    ActiveSheet.Range("D:F").EntireColumn.Hidden = True
    ActiveSheet.Range("H:J").EntireColumn.Hidden = True

    With ThisWorkbook.Worksheets("Programmation générale").ListObjects("ProgrammationGenerale").Sort
        .SortFields.Clear
        .SortFields.Add _
            Key:=.Parent.ListColumns("Début_Date").DataBodyRange, SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'Arrange for printing
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveSheet.PageSetup.PaperSize = xlPaperLegal

End Sub

0 个答案:

没有答案