Проблемы с подпрограммой и кодом

Question

У меня проблемы (я уже писал ранее), но я думаю, что мне не хватает чего-то глупого. У меня есть цикл, который работает, хотя 9 команд в A4-A12 и принимает каждое имя команды и запускает свой суб под названием 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$1:$R$1048576").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)