Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
VBA - Tabellenblatt mit verschiedene Namen aufrufen/wechseln

Baumstrukturmodus
VBA - Tabellenblatt mit verschiedene Namen aufrufen/wechseln
balzmatthias Offline
CEF Einsteiger
*
Registriert seit: 24.07.2020
Version(en): Office 356
#1
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
Zitieren Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#2
06.12.2021, 15:21 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2021, 15:24 von Gast 123.)
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??
Zitieren Suchen
Antworten Top
balzmatthias Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.07.2020
Version(en): Office 356
#3
06.12.2021, 15:28 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2021, 21:04 von WillWissen. Bearbeitungsgrund: Codetags )
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
Zitieren Suchen
Antworten Top
balzmatthias Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.07.2020
Version(en): Office 356
#4
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
Zitieren Suchen
Antworten Top
Klaus-Dieter Offline
Excel und VBA
Registriert seit: 11.04.2014
Version(en): Office 365
#5
06.12.2021, 19:11
Hallo,

ich kann gar nicht glauben, dass du das Makro hier aus dem Forum hast.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Homepage Zitieren Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#6
06.12.2021, 20:00 (Dieser Beitrag wurde zuletzt bearbeitet: 06.12.2021, 20:04 von Gast 123.)
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.
Zitieren Suchen
Antworten Top
balzmatthias Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 24.07.2020
Version(en): Office 356
#7
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
Zitieren Suchen
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste