Registriert seit: 24.07.2020
Version(en): Office 356
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
Registriert seit: 12.03.2016
Version(en): Excel 2003
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??
Registriert seit: 24.07.2020
Version(en): Office 356
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
Registriert seit: 24.07.2020
Version(en): Office 356
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
Registriert seit: 11.04.2014
Version(en): Office 365
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
Registriert seit: 12.03.2016
Version(en): Excel 2003
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.
Registriert seit: 24.07.2020
Version(en): Office 356
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
|