Live-Forum - Die aktuellen Beiträge
Datum
Titel
07.05.2024 21:30:42
Bilder aus URL in Zelle einfügen - Code anpassen
07.05.2024 20:36:09
xverweis / name Funktion
07.05.2024 20:10:42
Datum z.B. 1897 wird nicht als Datum angezeigt
07.05.2024 19:47:07
Excel Lohnabrechnung anhand 2 Suchkriterien
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1896to1900
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1896to1900
1896to1900
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

alle Makros aufrufen

alle Makros aufrufen
13.09.2022 05:38:43
Björn
Hallo
ich habe in 15 verschiedenen Sheets den folgenden Code eingebaut:

Public Sub HoleDaten()
Application.Wait Now + TimeSerial(0, 0, 2) 'wartet 2 Sekunden
'löscht die Filter in Spalte C und F
ActiveSheet.Range("$A$4:$L$10000").AutoFilter Field:=3
ActiveSheet.Range("$A$4:$L$10000").AutoFilter Field:=6
ActiveSheet.Range("$A$4:$L$10000").AutoFilter Field:=9
Application.Wait Now + TimeSerial(0, 0, 2) 'wartet 2 Sekunden
'loescht Daten in Spalte C bis L und Bereich ab A6 bis B10000
Columns("C:L").Select
Selection.ClearContents
Range("A6:B6").Select
Selection.AutoFill Destination:=Range("A6:B10000")
Range("A6:B10000").Select
Selection.ClearContents
Range("A1").Select
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Pfad = "X:\Benutzer_Daten\Produktionsmeeting\Stehzeit\"
Dateiname = "Stehzeitliste Schäumerei Fill.xlsx" ' aus welcher Datei soll er holen?
Blatt = "Stehzeitliste"  ' von welcher Tabelle soll er holen?
Bereich = "A4:J10000"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("C4")  ' in welchen Bereich soll er kopieren? Genauer gesagt: _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert" & Chr(10) & Chr(10) & Chr(169) & " Ing. Byörn Tschinkl"
End If
Application.Wait Now + TimeSerial(0, 0, 2) 'wartet 2 Sekunden
'   kopiert Formeln aus Zelle A5 und B5 bis zum Ende der Spalte C
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(Range("C65536")), Range("C65536").End(xlUp).Row, 65536)
Range("A5:B5").AutoFill Destination:=Range("A5:B" & LoLetzte)
Application.Wait Now + TimeSerial(0, 0, 2) 'wartet 2 Sekunden
'Filtern Makro
ActiveSheet.Range("$A$4:$L$10000").AutoFilter Field:=3, Criteria1:=""
ActiveSheet.Range("$C$4:$L$10000").AutoFilter Field:=6, Criteria1:="Maschine"
ActiveSheet.Range("$C$4:$L$10000").AutoFilter Field:=9, Criteria1:="Anlagenstillstand"
'filtert nach Jahr
'ActiveSheet.Range("$A$4:$V$10000").AutoFilter Field:=1, Operator:= _
' xlFilterValues, Criteria2:=Array(0, "12/31/2021")
'ActiveWindow.SmallScroll Down:=-24
End Sub
Nun möchte ich auf dem Master Sheet alle Codes mit einer Schaltfläche auf einmal ausführen. Mit Call bekomm ich das nicht hin. Bitte um Hilfe

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: alle Makros aufrufen
13.09.2022 06:55:50
Oberschlumpf
Hi Björn,
hast du diese Frage vor Kurzem nicht schon mal gestellt? (kommt mir zumindest sehr bekannt vor)
Zeig mal bitte per Upload eine Bsp-Datei mit 3 Bsp-Sheets und genügend Bsp-Daten überall da, wo erforderlich.
Ciao
Thorsten
CP aus vba forum ....
13.09.2022 08:03:14
ralf_b
Moin Thorsten,
Das mit dem "kommt mir bekannt vor", hab ich auch gedacht und nachgefragt , als ich es im VBA forum gelesen hatte.
Da ist er vom 07.09., Aber um das vorweg zu nehmen. Er hat nichts ähnliches gefunden.
AW: CP aus vba forum ....
13.09.2022 08:06:22
Oberschlumpf
Hi Ralf,
ah, danke schön! :-)
Na Björn, wie isset nu mit Bsp-Dateien?
Ciao
Thorsten
AW: CP aus vba forum ....
13.09.2022 08:51:33
Byörn
Hi kann das file leider nicht hochladen, da es 2,6MB groß ist.....
Anzeige
AW: CP aus vba forum ....
13.09.2022 08:58:32
Oberschlumpf
hi, bei nur 4 Sheets noch immer 2,6 MB?
dann lösch unnötige Spalten/Zeilen - eine Bsp-Datei muss nich 1000de Zeilen oder 100de Spalten enthalten
dann "verpack" die große Bsp-Datei mit 7ZIP in eine ZIP-Datei = wie groß ist die ZIP-Datei? kleiner oder gleich 300kb? = ZIP-Datei uploaden
AW: CP aus vba forum ....
13.09.2022 12:26:51
Byörn
Habe nun die Datei hochgeladen. Bitte um euer geschätztes Wissen. Danke
AW: alle Makros aufrufen
13.09.2022 08:41:09
Daniel
Hi
Wenn 15 x den gleichen Code in 15 verschiedenen Blättern hast, dann ist das Unsinn.
Der Code ist ja so geschrieben dass er immer das aktive Blatt bearbeitet.
Von daher sollte der Code einmal in ein allgemeines Modul und dann installiert du auf jedem Blatt einen Formular-Button, den du mit diesem Makro vernüpfst.
Wenn du dann Blätter durcharbeiten willst, reicht dieser Code:

Dim sh as Worksheet
For each sh in ThisWorkbook.Worksheets
Select Case sh.Name
Case "Hier Blattnamen aufführen, die nicht bearbeitet werden sollen"
Case Else
sh.Select
Call HoleDaten
End Select
Next
Gruß Daniel
Anzeige
AW: Makro wiederholt aufrufen
13.09.2022 12:12:46
GerdL
Im Makro HoleDaten sebst ändern:
Dateiname = "Stehzeitliste " & ActiveSheet.Name & ".xlsx"
Sonst ist der geschleifte Aufruf für die Katz.
Gruß Gerd
AW: alle Makros aufrufen
13.09.2022 13:13:30
Rudi
Hallo,
in ein Modul:

Public Sub HoleDaten()
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Dim LoLetzte As Long
Dim wks As Worksheet
For Each wks In Worksheets
With wks
Select Case .Name
Case "Master": 'nix passiert
Case Else
'löscht die Filter
If .FilterMode Then wks.ShowAllData
.Cells.ClearContents
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Pfad = "X:\Benutzer_Daten\Produktionsmeeting\Stehzeit\"
Dateiname = "Stehzeitliste " & .Name & ".xlsx" ' aus welcher Datei soll er holen?
Blatt = "Stehzeitliste"  ' von welcher Tabelle soll er holen?
Bereich = "A4:J10000"   ' aus welchem Bereich soll er holen?
Set Ziel = .Range("C4")  ' in welchen Bereich soll er kopieren? Genauer gesagt: _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert" & Chr(10) & Chr(10) & Chr(169) & " Ing. Byörn Tschinkl"
End If
LoLetzte = IIf(IsEmpty(.Cells(Rows.Count, 3)), .Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)
.Range(.Cells(5, 1), .Cells(LoLetzte, 1)).FormulaR1C1 = "=year(rc[2])"
.Range(.Cells(5, 2), .Cells(LoLetzte, 2)) = wks.Name
'Filtern Makro
.Range("$A$4:$L$10000").AutoFilter Field:=3, Criteria1:=""
.Range("$C$4:$L$10000").AutoFilter Field:=6, Criteria1:="Maschine"
.Range("$C$4:$L$10000").AutoFilter Field:=9, Criteria1:="Anlagenstillstand"
End Select
End With
Next wks
End Sub
Ebenso deine Function. Alles in den Blättern kannst du löschen.
Gruß
Rudi
Anzeige
AW: alle Makros aufrufen
13.09.2022 14:21:34
Byörn
Perfekt Danke dir sehr herzlich.
Ein kleines Problem noch. Wie bekomme ich es hin, dass Msg Box nur am Schluss kommt und nicht bei jedem Import.
AW: alle Makros aufrufen
13.09.2022 14:48:18
Rudi
Hallo,
schieb's hinter Next wks.
Oder lösch's komplett.
Gruß
Rudi
AW: alle Makros aufrufen
14.09.2022 06:18:26
Byörn
Löschen und verschieben funktioniert nicht. da bekomm ich keine Daten in die Sheets rein.....
AW: alle Makros aufrufen
14.09.2022 12:02:41
Byörn
Vielleicht hat jemand eine Idee? Danke
Idee?
14.09.2022 13:40:23
ralf_b
du hast dich doch schon bei SNB bedankt. Fehlt noch was?
AW: Idee?
14.09.2022 13:45:21
Byörn
der code von Rudi funktioniert perfekt, jedoch würde ich gerne die MSG Box weg bekommen.
In der Mappe sind 15 sheets und bei jedem Import kommt die Meldung. Ich hab die Box schon ausgeblendet, dann funktioniert der code aber nicht mehr..
Anzeige
AW: Idee?
14.09.2022 14:06:03
ralf_b
dann hast du es falsch ausgeblendet. ein hochkomma vor das MsgBox und fertig
AW: Idee?
14.09.2022 14:16:55
Byörn
hab ich mit Hochkoma gemacht, aber dann kommen keine Daten rein
AW: Idee?
14.09.2022 14:18:50
ralf_b
zeig mal den aktuellen Code
AW: Idee?
14.09.2022 14:21:44
Byörn 

Option Explicit
Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, sourceSheet As String, _
SourceRange As String, TargetRange As Range) As Boolean
'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© byoern.tschinkl@aon.at
' wird durch die HoleDaten aufgerufen
Dim strQuelle       As String
Dim Zeilen          As Long
Dim Spalten         As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range( _
SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function
InvalidInput: MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from _closed Workbook"
GetDataClosedWB = False
End Function
Public Sub HoleDaten()
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Dim LoLetzte As Long
Dim wks As Worksheet
For Each wks In Worksheets
With wks
Select Case .Name
Case "Master": 'Sheet wird nicht gelöscht
Case "Grafik": 'Sheet wird nicht gelöscht
Case Else
'löscht die Filter
If .FilterMode Then wks.ShowAllData
.Cells.ClearContents
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Pfad = "X:\Benutzer_Daten\Produktionsmeeting\Stehzeit\"
Dateiname = "Stehzeitliste " & .Name & ".xlsx" ' aus welcher Datei soll er holen?
Blatt = "Stehzeitliste"  ' von welcher Tabelle soll er holen?
Bereich = "A4:J10000"   ' aus welchem Bereich soll er holen?
Set Ziel = .Range("C4")  ' in welchen Bereich soll er kopieren? Genauer gesagt: _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert" & Chr(10) & Chr(10) & Chr(169) & " Ing. Byörn Tschinkl"
End If
LoLetzte = IIf(IsEmpty(.Cells(Rows.Count, 3)), .Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)
.Range(.Cells(5, 1), .Cells(LoLetzte, 1)).FormulaR1C1 = "=year(rc[2])"
.Range(.Cells(5, 2), .Cells(LoLetzte, 2)) = wks.Name
'Filtern Makro
.Range("$A$4:$L$10000").AutoFilter Field:=3, Criteria1:=""
.Range("$C$4:$L$10000").AutoFilter Field:=6, Criteria1:="Maschine"
.Range("$C$4:$L$10000").AutoFilter Field:=9, Criteria1:="Anlagenstillstand"
End Select
End With
Next wks
End Sub

Anzeige
Idee !
14.09.2022 14:24:08
Rudi 

        Public Sub HoleDaten()
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Dim LoLetzte        As Long
Dim wks             As Worksheet
Dim AnzDat          As Integer
For Each wks In Worksheets
With wks
Select Case .Name
Case "Master": 'nix passiert
Case Else
'löscht die Filter
If .FilterMode Then wks.ShowAllData
.Cells.ClearContents
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Pfad = "X:\Benutzer_Daten\Produktionsmeeting\Stehzeit\"
Dateiname = "Stehzeitliste " & .Name & ".xlsx" ' aus welcher Datei soll er holen?
Blatt = "Stehzeitliste"  ' von welcher Tabelle soll er holen?
Bereich = "A4:J10000"   ' aus welchem Bereich soll er holen?
Set Ziel = .Range("C4")  ' in welchen Bereich soll er kopieren? Genauer gesagt: _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
AnzDat = AnzDat + 1
End If
LoLetzte = IIf(IsEmpty(.Cells(Rows.Count, 3)), .Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count)
.Range(.Cells(5, 1), .Cells(LoLetzte, 1)).FormulaR1C1 = "=year(rc[2])"
.Range(.Cells(5, 2), .Cells(LoLetzte, 2)) = wks.Name
'Filtern Makro
.Range("$A$4:$L$10000").AutoFilter Field:=3, Criteria1:=""
.Range("$C$4:$L$10000").AutoFilter Field:=6, Criteria1:="Maschine"
.Range("$C$4:$L$10000").AutoFilter Field:=9, Criteria1:="Anlagenstillstand"
End Select
End With
Next wks
MsgBox AnzDat & " Dateien importiert" & Chr(10) & Chr(10) & Chr(169) & " Ing. Byörn Tschinkl"
End Sub
Gruß
Rudi
Anzeige
AW: Idee !
14.09.2022 14:30:29
Byörn
PERFEKT Rudi....
Ihr seit einfach spitze. Jetzt funktioniert es wie es soll
AW: alle Makros aufrufen
13.09.2022 17:52:03
snb 

Sub M_snb()
For Each it In sheets
if it.name "Master" then
it.cells.clear
it.cells(1,3).resize(10000,10)=getobject("X:\Benutzer_Daten\Produktionsmeeting\Stehzeit\" & it.Name & ".xlsx").sheets("Stehzeitliste").Range("A4:J10004").value
it.cells(1).resize(10000)=Year(date)
it.cells(1,2).resize(10^4)=it.name
With it.usedrange
.AutoFilter 1, ""
.Autofilter 6, "Maschine"
.AutoFilter 9, "Anlagenstillstand"
End With
End if
Next
End Sub

AW: alle Makros aufrufen
14.09.2022 05:17:32
Byörn
ihr seit die Besten. DANKESCHÖN
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige