子程序和代码的问题

Question

我遇到了问题（我之前发过帖子）但我想我漏掉了一些愚蠢的东西。我有一个循环通过 A4-A12 中的 9 个团队运行并获取每个团队名称并运行我的名为 Dataorangise 的子程序，这为 9 个团队中的每个团队运行一个循环但它不起作用

我有的是

Sub Looproutine()

Dim TeamName As String

For i = 4 To 12

TeamName = Sheets("Parameter").Range("A" & i).Value 'identify the location

    Call Dataorganise(TeamName) ' Call subroutine

Next i

End Sub

那么运行的代码是

Sub Dataorganise(TeamName As String)

Sheets("Data").Range("A:X").copy Destination:=Sheets(TeamName).Range("A1")

Columns("R:R").Select
Selection.AutoFilter
ActiveSheet.Range("$R:$R48576").AutoFilter Field:=1, Criteria1:= _
TeamName

Columns("A:J").Select
Selection.Delete Shift:=xlToLeft
Columns("B:G").Select
Selection.Delete Shift:=xlToLeft
Columns("C:G").Select
Selection.Delete Shift:=xlToLeft
Range("A1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Columns("A:D").Select
Range("D1").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    TeamName & "!R1C1:R1048576C3", Version:=xlPivotTableVersion12). _
    CreatePivotTable TableDestination:=TeamName & "!R1C5", TableName:= _
    "PivotTable7", DefaultVersion:=xlPivotTableVersion12

Answer 1

尝试这样的事情：

Sub Looproutine()

    Dim TeamName              As String

    For i = 4 To 12

        TeamName = Sheets("Parameter").Range("A" & i).Value    'identify the location

        Call Dataorganise(TeamName)    ' Call subroutine

    Next i

End Sub

Sub Dataorganise(TeamName As String)
    Dim ws                    As Worksheet
    Dim pt as pivottable
    Set ws = Sheets(TeamName)
    Sheets("Data").Range("A:X").Copy Destination:=ws.Range("A1")
    With ws
        .AutoFilterMode = False
        .Columns("R:R").AutoFilter Field:=1, Criteria1:=TeamName
        .Range("A:J,L:Q,T:X").EntireColumn.Delete Shift:=xlToLeft
        .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
        .Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("A:D").Delete Shift:=xlToLeft
    End With
    Set pt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                SourceData:="'" & TeamName & "'!" & ws.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1), _
                                Version:=xlPivotTableVersion12).CreatePivotTable( _
                                TableDestination:="'" & TeamName & "'!R1C5", _
                                DefaultVersion:=xlPivotTableVersion12)

子程序和代码的问题

Issues with Subroutine and Code

vba

excel

loops

subroutine