Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > VBA - Tabellenblatt mit verschiedene Namen aufrufen/wechseln
Normale Version: VBA - Tabellenblatt mit verschiedene Namen aufrufen/wechseln
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.

balzmatthias

06.12.2021, 15:09
Hallo zusammen.

Ich habe ein Makro (dank ans Forum) was aus einer externen Excel Datei daten in die Arbeitsdatei kopiert und auswertet.
Momentan ist es so das ich das für jedes Tabellenblatt der externen Datei machen muss.

Gibt es einen VBA Möglichkeit, wenn das Makro durchgelaufen ist VBA auf das nächste Tabellenblatt hüpft?
An sich ist das ja kein Problem mit Sheet select.

Aber das Problem ist die externe Datei hat eine unterschiedliche Anzahl an Tabellen und die Reiter haben nicht immer der selben Namen.

Danke

Gast 123

06.12.2021, 15:21
Hallo

kannst du uns das existierende Makro bitte mal hochladen, dann können wir es dir sicher umschreiben. 
Kann aber bis morgen dauern, ich mache gleich Schluss ...  Oder ein Kollege schreibt es dir um.

mfg Gast 123
nachtrag   müssen die Daten in allen Tabellen immer aus den gleichen Zellen geholt werden, oder sind es verschiedene Zellen??

balzmatthias

06.12.2021, 15:28
Hallo zusammen

hier das Makro, aber ich bin nicht der super Anwender, ich denke viel ist Impro.


Code:
Sub START()
Application.StatusBar = "Daten werden importiert und ausgewertet"
Application.ScreenUpdating = False
    Call DATEN_IMPORT
    Call DATEN_ANPASSEN
    Call DATEN_KOPIEREN_1SD4_1GO5
    Call DATEN_KOPIEREN_1GOH
    Call DATEN_1SD4_1GO5_SORT
    Call DATEN_1GOH_SORT

Application.StatusBar = True
Application.ScreenUpdating = True
End Sub

Sub DATEN_IMPORT()
'
' DATEN_IMPORT Makro
'

'

    Windows("Export.xls").Activate
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("SAB_GA_IMPORT.xlsb").Activate
    Sheets("Daten_EQX_IMPORT").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C4").Select
    End Sub
Sub DATEN_ANPASSEN()
'
' DATEN_ANPASSEN Makro
'
    Columns("B:B").Select
    Range("B4").Activate
    Selection.FormatConditions.Add Type:=xlTextString, String:="EQUINOX", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Rows("22:22").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Range("A20").Select
    Selection.Copy
    Range("A23:A2000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("$A$22:$W$2000").AutoFilter Field:=1
'

End Sub
Sub DATEN_KOPIEREN_1SD4_1GO5()
'
' DATEN_KOPIEREN Makro
'

'
    Sheets("Daten_EQX_IMPORT").Select
    Range("E1").Select
    Selection.Copy
    Range("E22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$A$22:$HZ$2000").AutoFilter Field:=1, Criteria1:= _
        "=*1GO5*", Operator:=xlOr, Criteria2:="=*1SD4*"

    Range("B4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Daten_EQX_OUTPUT_1SD4_1GO5").Select
    Range("A3").Select
    ActiveWindow.SmallScroll Down:=-18
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H20:AZ20").Select
    Selection.Style = "Percent"

End Sub
Sub DATEN_KOPIEREN_1GOH()
'
' DATEN_KOPIEREN Makro
'

'
    Sheets("Daten_EQX_IMPORT").Select
    Range("E1").Select
    Selection.Copy
    Range("E22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$A$22:$HZ$2000").AutoFilter Field:=1, Criteria1:= _
        "=*1GOH*", Operator:=xlOr, Criteria2:="=*1GOH*"

    Range("B4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Daten_EQX_OUTPUT_1GOH").Select
    Range("A3").Select
    ActiveWindow.SmallScroll Down:=-18
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H20:AZ20").Select
    Selection.Style = "Percent"
    Sheets("Home").Select
End Sub

Sub DATEN_1SD4_1GO5_SORT()
'
' DATEN_1SD4_1GO5_SORT Makro
'

'
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-33
    ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1SD4_1GO5").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1SD4_1GO5").Sort.SortFields.Add _
        Key:=Range("A2:HZ2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1SD4_1GO5").Sort
        .SetRange Range("A2:HZ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
        Range("P1").Select
    'ActiveCell.FormulaR1C1 = "1"
    Sheets("Home").Select
        Range("A1").Select
End Sub

Sub DATEN_1GOH_SORT()
'
' DATEN_1SD4_1GO5_SORT Makro
'

'
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-33
    ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1GOH").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1GOH").Sort.SortFields.Add _
        Key:=Range("A2:HZ2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Daten_EQX_OUTPUT_1GOH").Sort
        .SetRange Range("A2:HZ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
        Range("P1").Select
    'ActiveCell.FormulaR1C1 = "1"
    Sheets("Home").Select
    Range("A1").Select
End Sub

balzmatthias

06.12.2021, 18:48
Hallo zusammen.

Gibt es nicht die Möglichkeit, das Makro, so oft zu wiederholen, so vielen Sheets vorhanden sind und immer ein Sheet weiter zu springen?

DANKE

Klaus-Dieter

06.12.2021, 19:11
Hallo,

ich kann gar nicht glauben, dass du das Makro hier aus dem Forum hast.

Gast 123

06.12.2021, 20:00
Hallo

probier bitte mal diese Code Variante.  Ich konnte sie aber nicht testen, es ist somit ein heiteres Ratespiel.
Kernstück ist der Import, wo ich über eine For next Schleife alle Daten hole, und im Sheet""Daten_EQX_IMPORT"" immer unten anhänge
Ich weiss aber nicht ob das so richtig ist un die übrigen Makros den größeren Datenbereich so verarbeiten können??   Wir werden sehen ....

mfg Gast 123

Code:
Dim Edr As String

Sub START()
Application.StatusBar = "Daten werden importiert und ausgewertet"
Application.ScreenUpdating = False
    Call DATEN_IMPORT
    Call DATEN_ANPASSEN
    Call DATEN_KOPIEREN_1SD4_1GO5
    Call DATEN_KOPIEREN_1GOH
    Call DATEN_1SD4_1GO5_SORT
    Call DATEN_1GOH_SORT
    Sheets("Home").Select
    Range("A1").Select
Application.StatusBar = True
Application.ScreenUpdating = True
End Sub


Sub DATEN_IMPORT()
' DATEN_IMPORT Makro
Dim lz1 As Long, k As Integer
For k = 1 To Windows("Export.xls").Worksheets.Count
   With Windows("Export.xls").Worksheets(k)
       Edr = .SpecialCells(xlLastCell).Address
      .Range("A1", Edr).Copy
   End With
   With Windows("SAB_GA_IMPORT.xlsb").Worksheets("Daten_EQX_IMPORT")
       lz1 = .Cells(Rows.Count, 2).End(xlUp).Row + 1
       .Range("B" & lz1).PasteSpecial Paste:=xlPasteValues, Transpose:=False
         Application.CutCopyMode = False
   End With
Next k
End Sub


Sub DATEN_ANPASSEN()
' DATEN_ANPASSEN Makro
With Windows("SAB_GA_IMPORT.xlsb")
With .Sheets("Daten_EQX_IMPORT").Range("B4")
     .FormatConditions.Add Type:=xlTextString, String:="EQUINOX", TextOperator:=xlContains
     .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    .FormatConditions(1).StopIfTrue = False
    .Rows("22:22").AutoFilter
    .Range("A23:A2000").Value = Range("A20")
    .Range("$A$22:$W$2000").AutoFilter Field:=1
End With
End With
End Sub


Sub DATEN_KOPIEREN_1SD4_1GO5()
' DATEN_KOPIEREN Makro
With Windows("SAB_GA_IMPORT.xlsb")
With .Sheets("Daten_EQX_IMPORT")
    .Range("E22").Value = .Range("E1").Value
    .Range("$A$22:$HZ$2000").AutoFilter Field:=1, Criteria1:= _
        "=*1GO5*", Operator:=xlOr, Criteria2:="=*1SD4*"
     Edr = .SpecialCells(xlLastCell).Address
    .Range("B4", Edr).Copy
End With
With .Sheets("Daten_EQX_OUTPUT_1SD4_1GO5")
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=False
    .Range("H20:AZ20").Style = "Percent"
End With
End With
End Sub


Sub DATEN_KOPIEREN_1GOH()
' DATEN_KOPIEREN Makro
With Windows("SAB_GA_IMPORT.xlsb")
With .Sheets("Daten_EQX_IMPORT")
    .Range("E22").Value = .Range("E1").Value
    .Range("$A$22:$HZ$2000").AutoFilter Field:=1, Criteria1:= _
        "=*1GOH*", Operator:=xlOr, Criteria2:="=*1GOH*"
     Edr = .SpecialCells(xlLastCell).Address
    .Range("B4", Edr).Copy
End With
With .Sheets("Daten_EQX_OUTPUT_1GOH")
    .Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=False
    Range("H20:AZ20").Style = "Percent"
End With
End With
End Sub


Sub DATEN_1SD4_1GO5_SORT()
' DATEN_1SD4_1GO5_SORT Makro
With Windows("SAB_GA_IMPORT.xlsb")
With .Worksheets("Daten_EQX_OUTPUT_1SD4_1GO5")
     .Sort.SortFields.Clear
     .Sort.SortFields.Add Key:=Range("A2:HZ2"), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range("A2:HZ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End With
End Sub


Sub DATEN_1GOH_SORT()
' DATEN_1SD4_1GO5_SORT Makro
With Windows("SAB_GA_IMPORT.xlsb")
With .Worksheets("Daten_EQX_OUTPUT_1GOH")
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("A2:HZ2"), SortOn:=xlSortOnValues, _
     Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range("A2:HZ2000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End With
End Sub
@Klaus-Dieter  bei dem vielen Select tippe uch auf Recorder Aufzeichnung.  Das programmiert keiner von uns.

balzmatthias

07.12.2021, 16:02
vielen Dank an alle hat funktioniert.

Und ja ich kann nicht programmieren sondern ist eine Aufzeichnung mit ein wenig aus dem Netz zusammen gesucht, aber es hat trotzdem funktioniert.

DANKE
Clever-Excel-Forum > Office-Anwendungen > Excel > VBA - Tabellenblatt mit verschiedene Namen aufrufen/wechseln