我知道我的代码看起来像科学怪人(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