尝试循环显示多个VBA表时发生错误

我已经写了这个代码来循环多个工作表并执行某个任务,但由于某种原因,我被告知下标在这一行超出范围:

Sheets(Worksheetss(indexVal)).Range("B4:S25").Select 

完整的代码可以在这里看到:

 Sub kopierforsatan() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayStatusBar = False Dim Worksheet As Variant Dim Worksheetss As Variant Dim outputs As Variant Worksheetss = Array("6_år_lav", "6_år_middel", "6_år_høj", "10_år_høj") Dim indexVal As Integer indexVal = 0 For Each Worksheet In Worksheetss Sheets(Worksheetss(indexVal)).Range("B4:S25").Select Application.CutCopyMode = False Selection.Copy Sheets(Worksheetss(indexVal)).Range("V4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Selection.Copy Sheets(Worksheetss(indexVal)).Range("V30").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Sheets(Worksheetss(indexVal)).Range("B54").Select Sheets(Worksheetss(indexVal)).Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Sheets(Worksheetss(indexVal)).Range("V50").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False Selection.Copy Sheets(Worksheetss(indexVal)).Range("Y30").Select ActiveSheet.Paste indexVal = indexVal + 1 Next Worksheet End Sub 

最让我困扰的是,我已经使用了这个语法,就每个循环的构造方式而言。

我希望有人能看到我犯了一个错误。

请参阅@ comintern的评论It's a horrible idea to use them for variable names, but VBA determines the context from scope and usage. If you have Dim Worksheets As Variant it just means that you have to qualify ThisWorkbook.Worksheets. Again, not the best idea. It's a horrible idea to use them for variable names, but VBA determines the context from scope and usage. If you have Dim Worksheets As Variant it just means that you have to qualify ThisWorkbook.Worksheets. Again, not the best idea. 至于为什么不应该使用worksheet作为variables。

另外尝试避免使用select。

第三次使用for循环多次不需要计数器。 只需引用您创build的variables。

 Sub kopierforsatan() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayStatusBar = False Dim ws As Variant Dim Worksheetss As Variant Dim outputs As Variant Worksheetss = Array("6_år_lav", "6_år_middel", "6_år_høj", "10_år_høj") For Each ws In Worksheetss With Sheets(ws) .Range("B4:S25").Copy .Range("V4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Range("V30").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True .Range(.Range("B54"), .Range("B54").End(xlDown)).Copy .Range("V50") .Range(.Range("B54"), .Range("B54").End(xlDown)).Copy .Range("Y30") End With Next ws Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = True End Sub 

你指的是Worksheetss ,它应该是Worksheets

您可以遍历工作簿中的所有工作表,然后检查当前工作表的名称是否与数组中的名称相同。

(我更喜欢使用名为Sht的variables,而不是接近`Worksheet1的东西)。

 Dim Sht As Worksheet For Each Sht In ThisWorkbook.Sheets With Sht Select Case .Name Case "6_år_lav", "6_år_middel", "6_år_høj", "10_år_høj" Application.CutCopyMode = False .Range("B4:S25").Copy .Range("V4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ' etc... continue the rest of your copy > Paste End Select End With Next Sht 

非常感谢你的提交和答复,然后那么快!

我设法实施了一个解决scheme使用@Scott Craners答案稍作修改。 修改只是必要的,因为我需要从B54创build的vector转置。

我会记住你们已经讨论过关于variables名称的约定,并且看看关于使用select和activate的链接。

非常感谢您的参与。

周末愉快。