Abfragen ob Blatt besteht, wenn ja Makro auslösen

Moderator: ModerationP

Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 08. Feb 2019, 07:35

Hallo Forum,

Ich habe ein Sammlung mit 20 ähnlichen Datei bestehend aus 3 Tabellenblätter wobei immer einer der Tabellen anders benannt ist.
Dieses wechselnde Tabellenblatt möchte ich per Makro in alle 20 Datei nacheinander aktualisieren mit vorher eingespielte Infos in das Blatt "Doku".

Folgende Lösung habe ich bis jetzt zusammengebastelt, funktioniert aber nicht.
Kann mir jemand sagen wo der Fehler liegt, danke.

Code: Alles auswählen

Sub DokuAktualisieren()
'
Application.ScreenUpdating = False
    Sheets("Doku").Select
    Range("D2:DF11").Select
    Selection.Copy
    Sheets(Array("Overview", "Bladder Accumulator", "Thermometer", "Contact Thermometer", "Pressure Transmitter")).Select
'jetzt sollte geprüft werden ob eine der Blätter existiert
'wenn ja, Blatt aktivieren und wenn nein, überspringen. Wie z.B.
    Sheets("Overview").Activate
    Range("K304").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Danke und viele Grüße
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Klaus-Dieter » 08. Feb 2019, 10:22

Hallo Twiti,

das passt einiges nicht. Diese Anweisung: Sheets(Array("Overview", "Bladder Accumulator", "Thermometer", "Contact Thermometer", "Pressure Transmitter")).Select bewirkt, dass alle genannten Tabellenblätter Selektiert werden. Aber nur, wenn es auch alle gibt, sonst kommt eine Fehlermeldung. Im Übrigen solltest du auf die Select-Anweisungen verzichten, die sind überflüssig.

Also nicht:
Code: Alles auswählen
Sheets("Doku").Select
    Range("D2:DF11").Select
    Selection.Copy


sondern:
Code: Alles auswählen
Sheets("Doku").Range("D2:DF11").Copy
Viele Grüße
Klaus-Dieter
Lösungsvorschläge sind, wenn es keinen anders lautenden Hinweis gibt, von mir getestet.
Künstliche Intelligenz ist besser als natürliche Dummheit.
Benutzeravatar
Klaus-Dieter
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 17739
Registriert: 27. Nov 2003, 23:03
Wohnort: Sassenburg

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 11. Feb 2019, 08:15

Hallo Klaus-Dieter,
ich bin wohl auf dem Holzweg.
Wenn's mit Array nicht funktioniert, welche Methode soll ich dann hernehmen?

Dein Tipp, der Code zu verkürzen ohne Select nehme ich mir zu Herzen, danke dafür.

Viele herzliche Grüße
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon 1Matthias » 11. Feb 2019, 08:27

Moin!
Das hier wäre eine Prüfung, ob das Blatt in deiner LIste vorhanden ist. Da ich den genauen Dateiaufbau nicht kenne, müsste du ggf. vor dem Blatt noch die Referenzierung auf das Workbook ergänzen. Wenn das Blatt Doku auch in der Datei ist, müßtest du eigentlich nichts ändern.
Code: Alles auswählen
Sub DokuAktualisieren()
Dim BlattNamen
Dim anzahl As Long

BlattNamen = Array("Overview", "Bladder Accumulator", "Thermometer", "Contact Thermometer", "Pressure Transmitter")

Application.ScreenUpdating = False
Sheets("Doku").Range("D2:DF11").Copy

For anzahl = 1 To 3 'Schleife durch alle Blätter
    If UBound(Filter(BlattNamen, Worksheets(anzahl).Name)) > -1 Then 'prüfen, ob das BLatt in der Arrayliste vorkommt
        Sheets(anzahl).Range("K304").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        Exit For
    End If
Next

Application.ScreenUpdating = True

End Sub


VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 566
Registriert: 15. Aug 2017, 18:36

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 12. Feb 2019, 08:34

Hallo Matthias,
danke für deine Hilfe.

Beim Ausführen des Makros bekomme ich folgende Fehlermeldung.

Error: 1004 die Select-Methode des Range-Objekt konnte nicht ausgeführt werden.

Beim Debugen gibt es keine Hinweise wo der Fehler liegt. Hast du eine Idee?
Hier, der kompletten Code

Code: Alles auswählen
 Sub Doku_ActualPick()
 'mehrfach Auswahl von Dateien
    Dim intZaehler As Integer
    Dim strPath As String
    Dim wb As Workbook
    On Error GoTo Fin
     With Application
         .ScreenUpdating = False
         .AskToUpdateLinks = False
         .EnableEvents = False
         .DisplayAlerts = False
     End With
     
    ' Dialog zum Auswählen der zu bearbeitenden Dateien öffnen
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
'Ordnerpfad einfügen
        .InitialFileName = "C:\Users\tom.witjes\Documents\Eigene Maps\"
        .Title = "Bitte die benötigte Dateien auswählen"
        .Show
        If .SelectedItems.Count = 0 Then
            ' es wurde nicht ausgewählt
            MsgBox ("Vorgang abgebrochen")
            Exit Sub
        Else
            ' alle ausgewählten Dateien durchlaufen
             For intZaehler = 1 To .SelectedItems.Count
                ' Pfad ermitteln
               strPath = .SelectedItems(intZaehler)
               ' Datei zum Bearbeiten öffnen
               Set wb = Workbooks.Open((strPath), Editable:=True)
               
' ausführbares Makro einfügen

'    DokuAktual

    Windows("Doku Master BTK.xlsm").Activate
    Sheets("DokuMaster").Range("A2:DF75").Copy
   
wb.Activate

Sheets("Doku").Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
AlleSpaltenEinblenden

' Doku im Komponentenblatt aktualisieren.
'wb.Activate
   
'Call DokuAktualisieren
Dim BlattNamen
Dim anzahl As Long

BlattNamen = Array("Ball Valve", "Bladder Accumulator", "Block and Bleed Valve", "Cable", "Cable Connection", "Centrifugal Pump", "Check Valve", "Contact Pressure Gauge", "Contact Thermometer", "Coupling", "Diff. Pressure Transmitter", "Fastener", "Filter", "Filter Element", "Fitting", "Floating Switch", "Flow Indicator", "Flow Limiter", "Flow Switch", "Flow Transmitter", "Gasket", "Heat Exchanger", "Hexagonal Nut", "Lifting Eye Bolt", "Motor", "Needle valve", "Nipple", "Paint", "Pipe Bend", "Pressure Gauge", "Pressure Transmitter", "Pressure Valve", "Protection Sleeve", "Pump Carrier", "Quick Connector", "Reducer", "Safety Valve", "Screw Bolt", "Solenoid Valve", "Stopper", "Strainer", "Temperature Transmitter", "Thermometer", "T-Iron", "Valve")

Application.ScreenUpdating = False
wb.Sheets("Doku").Range("D2:DF11").Copy

For anzahl = 1 To 3 'Schleife durch alle Blätter
    If UBound(Filter(BlattNamen, Worksheets(anzahl).Name)) > -1 Then 'prüfen, ob das BLatt in der Arrayliste vorkommt
        Sheets(anzahl).Range("K304").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
       
        Exit For
    End If
Next


Range("B2").Select
FilterAusblenden
                ' Datei schließen und Änderungen nicht speichern(false) //speichern (True)
                wb.Close SaveChanges:=True 'False
        Next intZaehler

       End If
    End With
                Application.ScreenUpdating = True

Fin:
     Set wb = Nothing
     With Application
         .ScreenUpdating = True
         .AskToUpdateLinks = True
         .EnableEvents = True
         .Calculation = xlAutomatic 'intCalc
         .DisplayAlerts = True
     End With
     If Err.Number <> 0 Then MsgBox "Error: " & _
         Err.Number & " " & Err.Description
    MsgBox ("Fertig")
End Sub


Viele Grüße
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Klaus-Dieter » 12. Feb 2019, 10:15

Hallo,

die Fehlermeldung besagt, dass es eines der Blätter nicht gibt, bzw. dass der Name falsch geschrieben ist.
Viele Grüße
Klaus-Dieter
Lösungsvorschläge sind, wenn es keinen anders lautenden Hinweis gibt, von mir getestet.
Künstliche Intelligenz ist besser als natürliche Dummheit.
Benutzeravatar
Klaus-Dieter
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 17739
Registriert: 27. Nov 2003, 23:03
Wohnort: Sassenburg

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon 1Matthias » 12. Feb 2019, 12:42

Moin!
Da kann man aus der Ferne nicht viel sagen. Wie Klaus Dieter schon schrieb, liegt das an einem Blattnamen. Da du mit mehreren Dateien arbeitest, solltest du vor jedes Sheet bzw. worksheet noch das Workbook ergänzen. DAmit ist die ZUordnung richtig. Könnte auch sein, das du noch das falsche WB aktiviert hast und es dort das Blatt nicht gibt,
Im Zweifel mal mit der F8 Tasten durch den Code gehen und schauen, in welcher Zeile der Code hängt. Dort dann nochmal prüfen, welches Blatt aktiv ist und welches es sein sollte.
Alternativ beschreib mal bitte, von wo nach wo kopiert werden soll, dann kann man das anpassen. Am Anfang wird ja aus der Dkou Master xlsm in die geöffnete Mappe kopiert. Danach wird in der geöffneten Mappe aus einem Blatt in das zu suchende Blatt (immer noch die selbe Mappe) kopiert ?
VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 566
Registriert: 15. Aug 2017, 18:36

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 12. Feb 2019, 14:18

Hallo Klaus-Dieter, hallo Matthias,

Bei einige Mappe geht es, bis er dann ein Fehler produziert.
Die Aufbau alle angesteuerten Dateien ist identisch (nur eine Tabelle hat jeweils ein angepasster Name, der sheet Nummer ist aber unterschiedlich).

Kann ich Fehler überspringen um herauszufinden welche Namen/Dateien fehlerhaft sind?
Danke
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Klaus-Dieter » 12. Feb 2019, 14:28

Hallo,

wenn das Makro auf einen Fehler läuft, wird doch angezeigt, wo der ist.
Viele Grüße
Klaus-Dieter
Lösungsvorschläge sind, wenn es keinen anders lautenden Hinweis gibt, von mir getestet.
Künstliche Intelligenz ist besser als natürliche Dummheit.
Benutzeravatar
Klaus-Dieter
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 17739
Registriert: 27. Nov 2003, 23:03
Wohnort: Sassenburg

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 12. Feb 2019, 15:02

Hallo Klaus-Dieter,
ich hab mal den Befehl: on error goto
deaktiviert und gehe auf der Suche.

Wenn ich es gefunden habe sage ich euch Bescheid (oder es wirft weitere Fragen auf.)+
Viele Grüße
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon 1Matthias » 12. Feb 2019, 17:40

Moin!
Ich hätte noch eine Änderung. Hat aber m.E: nichts mit deinem Fehler zu tun. Und zwar ändere mal die Suche des Blattnamens wie folgt.
Code: Alles auswählen
BlattNamen = "#" & Join(BlattNamen, "#") & "#"
For anzahl = 1 To 3 'Schleife durch alle Blätter
    If InStr(1, BlattNamen, "#" & Worksheets(anzahl).Name & "#") > 0 Then 'prüfen, ob das BLatt in der Arrayliste vorkommt
        Sheets(anzahl).Range("K304").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Exit For
    End If
Next

Hintergrund ist, dass bei FILTER auch Teilmengen mitgenommen werden. Soll heißen. Du hast ein Blatt mit Namen "Cable". In der LIste der Blattnamen kommt aber nur "Cable xbx" vor. Dann wird bei Filter trotzdem ein Treffer ausgegeben, da "Cable" enthalten ist.
VG
1Matthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 566
Registriert: 15. Aug 2017, 18:36

Re: Abfragen ob Blatt besteht, wenn ja Makro auslösen

Beitragvon Twiti » 13. Feb 2019, 14:36

Servus Matthias, hallo Klaus-Dieter,
@Matthias, danke für die Ergänzung.

Nachdem ich der ON ERROR GOTO… rausgenommen habe konnte ich der Fehler finden.
Nach langem Suchen fand ich heraus dass in das Blatt Doku einige Spalten ausgeblendet waren (auch SpalteA).
Nach Einblenden allen Spalten lief der Code wie geschmiert.

Zu dieses Thema habe ich keine weitere Fragen und danke für die Unterstützung.
Viele Grüße
Twiti
Windows 10/Office 2010
Dragon NaturallySpeaking statt Maus und Tastatur wegen Schwerbehinderung
Twiti
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 198
Registriert: 23. Apr 2016, 13:53


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: Ivan 16, Maddin7, Mpro70, Trama und 34 Gäste