Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein

Betrifft: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: J.
Geschrieben am: 18.02.2008 11:52:50

Hallo
Ich möchte gerne mit einem Makro eine andere Arbeitsmappe öffnen, dort drin dann unter ca 100 Arbeitsblättern das richtige suchen und einen vorher ausgewählten Text dort hinein kopieren.
Das praktische ist, dass sich in jedem Arbeitsblatt in Zelle A1 der Begriff befindet, nach dem das Makro das Arbeitsblatt auswählen soll. Desweiteren sollte das Makro den zu kopierenden Text nicht immer in die 2. Zeile schreiben, sondern, sofern diese Zeile bereits belegt ist, in die Zeile darunter schreiben.
Die kopierten Werte stammen aus einer Tabelle, und umfassen jeweils 1 Zeile und 9 Spalten.

Das öffnen des Arbeitsblatte bekomme ich soweit schon hin, denn es klappt mit
Workbooks.Open Filename
ganz gut.

Nachher sollte die Arbeitsmappe dann noch gespeichert und wieder geschlossen werden.

  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: fcs
Geschrieben am: 18.02.2008 13:19:15

Hallo J.,

hier eine Lösung, die du noch ein wenig an deine daten anpassen muss.

Gruß
Franz

Sub DatenEintragen()
  Dim wbQuelle As Workbook, wksQuelle As Worksheet, strSuchbegriff As Variant
  Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZiel As Long
  Dim strDateiname As String, Bereich As Range
  strSuchbegriff = InputBox("Suchbegriff in Zieldatei?")
  If strSuchbegriff = "" Then Exit Sub
  Set wbQuelle = ThisWorkbook
  Set wksQuelle = wbthis.Worksheets("Tabelle1") 'Tabellenblatt mit den Daten
   'Bereich mit den zu übertragenden Werten, ggf. Anpassen
  With wksQuelle
    Set Bereich = .Range(.Cells(3, 1).Cells(3, 9)) 'A3:I3
  End With
  strDateiname = "C:\Lokale Daten\Test\Mappe1.xls"
  Set wbZiel = Workbooks.Open(Filename:=strDateiname)
  For Each wksZiel In wbZiel.Worksheets
    If wksZiel.Range("A1") = strSuchbegriff Then
      With wksZiel
        'nächste freie Zeiel im Zielblatt
        ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'Daten (nur Werte) kopieren
        Bereich.Copy
        .Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
      End With
      Exit For
    End If
  Next
  'Zieldatei speichern und schliessen
  wbZiel.Save
  wbZiel.Close
  Set wbQuelle = Nothing: Set wksQuelle = Nothing
  Set wbZiel = Nothing: Set wksZiel = Nothing
End Sub




  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: J.
Geschrieben am: 18.02.2008 13:57:19

Ich habe den quelltext jetzt wie folgt verändert, leider erhalte ich noch eine Fehlermeldung

Dim wbQuelle As Workbook, wksQuelle As Worksheet, strSuchbegriff As Variant
Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZiel As Long
Dim strDateiname As String, Bereich As Range
strSuchbegriff = [o1]
If strSuchbegriff = "" Then Exit Sub
Set wbQuelle = ThisWorkbook
Set wksQuelle = Worksheets("sonstiges") 'Tabellenblatt mit den Daten
'Bereich mit den zu übertragenden Werten, ggf. Anpassen
With wksQuelle
Set Bereich = .Range(.Cells(5, 10).Cells(5, 17)) 'J5:Q5
End With
strDateiname = "C:\Eigene Dateien\Störfallhandbuch\Störfallhandbuch Bauteilgruppen\Störfalllogbuch Maschinen.xls"
Set wbZiel = Workbooks.Open(Filename:=strDateiname)
For Each wksZiel In wbZiel.Worksheets
If wksZiel.Range("A1") = strSuchbegriff Then
With wksZiel
'nächste freie Zeile im Zielblatt
ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'Daten (nur Werte) kopieren
Bereich.Copy
.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
Exit For
End If
Next
'Zieldatei speichern und schliessen
wbZiel.save
wbZiel.Close
Set wbQuelle = Nothing: Set wksQuelle = Nothing
Set wbZiel = Nothing: Set wksZiel = Nothing

und zwar bei

With wksQuelle
Set Bereich = .Range(.Cells(5, 10).Cells(5, 17)) 'J5:Q5

da sagt er dass die Methode Range für das Objekt Worksheet fehlgeschlagen ist


  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: fcs
Geschrieben am: 18.02.2008 14:30:03

Hallo J.,

da hatte sich, da Code mangels Testdaten ungetestet, ein Fehler eingeschlichen. Es fehlt ein Komma.

Set Bereich = .Range(.Cells(5, 10), .Cells(5, 17)) 'J5:Q5


Gruß
Franz


  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: J.
Geschrieben am: 18.02.2008 14:41:51

ok Fehler behoben.
Ich sehe gerade jedoch, dass auf Tabelle 1 eine Auflistung aller Maschinen ist, daher findet das Makro direkt auf Seite 1 den Suchbegriff. Seltsamerweise wird jedoch nirgendwo etwas hin kopiert. es passiert einfach garnichts


  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: fcs
Geschrieben am: 18.02.2008 15:35:48

Hallo J.,

das Makro prüft in den Tabellenblättern der Zieldatei nur die Zelle A1 auf Übereinstimmung mit dem Suchbegriff.

Wenn auf dem Blatt 1 in Zelle A1 kein Maschinenname steht, dann werden dort auch keine Daten eingetragen.

Ich hab jetzt mal eine Zieldatei nachgebastelt. Das Makro funktioniert. Ich hab es um eine Meldung ergänzt, wenn die Maschine nicht gefunden wird, und die Variable "strSuchbegriff" in "varSuchbegriff" umbenannt.

Gruß
Franz

Sub DatenEintragen()
  Dim wbQuelle As Workbook, wksQuelle As Worksheet, varSuchbegriff As Variant
  Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZiel As Long
  Dim strDateiname As String, Bereich As Range, boGefunden As Boolean
  varSuchbegriff = [o1]
  If varSuchbegriff = "" Then Exit Sub
  Set wbQuelle = ThisWorkbook
  Set wksQuelle = wbQuelle.Worksheets("sonstiges") 'Tabellenblatt mit den Daten
  'Bereich mit den zu übertragenden Werten, ggf. Anpassen
  With wksQuelle
    Set Bereich = .Range(.Cells(5, 10), .Cells(5, 17)) 'J5:Q5
  End With
  strDateiname = "C:\Eigene Dateien\Störfallhandbuch\Störfallhandbuch Bauteilgruppen\Stö _
rfalllogbuch Maschinen.xls"
  strDateiname = "C:\Lokale Daten\Test\Mappe1.xls"
  Set wbZiel = Workbooks.Open(Filename:=strDateiname)
  boGefunden = False
  For Each wksZiel In wbZiel.Worksheets
    If wksZiel.Range("A1") = varSuchbegriff Then
      boGefunden = True
      With wksZiel
        'nächste freie Zeile im Zielblatt
        ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'Daten (nur Werte) kopieren
        Bereich.Copy
        .Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
      End With
      Exit For
    End If
  Next
  If boGefunden = True Then
    'Zieldatei speichern und schliessen
    wbZiel.Save
    wbZiel.Close
  Else
    wbZiel.Close savechanges:=False
    MsgBox "Maschine """ & varSuchbegriff & """ in Zieldatei nicht gefunden."
  End If
  Set wbQuelle = Nothing: Set wksQuelle = Nothing
  Set wbZiel = Nothing: Set wksZiel = Nothing
End Sub




  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: J.
Geschrieben am: 18.02.2008 15:47:31

Hey das mit der gefunden abfrage funktioniert schonmal Prima, er findet nämlich nichts :-)

Sucht der eigentlich nach einer völligen Übereinstimmung beim Suchwort? Denn der Begriff nach dem ich suche ist nur ein Teil des Begrifs aus Zelle A1.
Bei mir steht zb auf Arbeitsblatt 3 in Zelle A1 05A94
Und wenn ich nach "A94" suche, bekomme ich die Meldung, dass nichts gefunden wurde.


  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: fcs
Geschrieben am: 18.02.2008 15:55:27

Hallo J.,

das mit der Teilstringsuche hättest du aber auch etwas früher melden könne.

Dazu muss die If-Bedingung zum Vergleich ein wenig angepasst werden.

  For Each wksZiel In wbZiel.Worksheets
    If InStr(1, wksZiel.Range("A1"), varSuchbegriff) > 0 Then
'    If wksZiel.Range("A1") = varSuchbegriff Then


gruß
Franz


  

Betrifft: AW: Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein von: J.
Geschrieben am: 18.02.2008 16:05:22

Funktioniert phantastisch

Danke "!!!!!!


 

Beiträge aus den Excel-Beispielen zum Thema "Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein"