Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Arbeitsmappe öffnen, Arbeitsblatt suchen, Text ein

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread