Code Anpassung

Sub TextInArbeitsmappeSuchenUndFärben() Dim suchbegriff As String Dim Mappe As Workbook Dim sht As Worksheet suchbegriff = InputBox("Geben Sie den Suchbegriff ein!") For Each Mappe In Application.Workbooks Mappe.Activate For Each sht In Worksheets sht.Activate Set found = sht.Cells.Find(suchbegriff) If Not found Is Nothing Then FirstAddress = found.Address Do found.Activate found.Interior.ColorIndex = 3 Set found = Cells.FindNext(After:=ActiveCell) On Error Resume Next If found.Address = FirstAddress Then Exit Do found.Interior.ColorIndex = 3 Loop End If Next sht Next Mappe End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Wb As Workbook For Each Wb In Application.Workbooks Select Case Wb.Name Case ThisWorkbook.Name Case Else If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then With ThisWorkbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(100, 6)) .ClearContents 'für Wiederholungen .Value = Wb.Worksheets("Tabelle1").Range(Wb.Worksheets("Tabelle1").Cells(1, 1), Wb. _ Worksheets("Tabelle1").Cells(100, 6)).Value End With Exit For End If End Select Next Wb End Sub

Hallo Gerd,
Erstmal vielen vielen Dank für Deine Mühe und Deine Hilfe.
Eine kleine Fehler bekomme ich in:
"With ThisWorkbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(100, 6))"
Laufzeitfehelr 9 Index außerhalb des gültigen Bereichs.
Ich habe es probiert mit "With Workbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(100, 6))" dabei bekomme ich den Fehler 424 Objekt erforderlich.
Dein Modul möchte ich sowieso in meine TestMappe.xlsm einbauen. Was ich leider immer noch nicht verstehe in Deinen Code ist dass ich nicht sehe das er kopieren soll (nur die Werte).
OK ich bin ein Anfänger villeicht fehlt es mir noch das Wissen dafür.
Aber verstehe ich es hier richtig:
"If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then"
'wenn der "USA" in Tabelle1 in "B2" gefunden wurde(egal ob das die MappeF oder MappeG ist)
"With ThisWorkbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(300, 6))"
'dann von diese Tabelle1 kopiere mir den Bereich "A1:F600"
'Jetzt müsste ich dann hier den Ziel Ergebnis eingeben und zwar die Tabelle6
".Value = Wb.Worksheets("Tabelle1").Range(Wb.Worksheets("Tabelle1").Cells(1, 1), Wb. _
Worksheets("Tabelle1").Cells(100, 6)).Value"
'ist das so richtig?
".Value = Wb.Worksheets("Tabelle6").Range(Wb.Worksheets("Tabelle6").Cells(1, 1), Wb. _
Worksheets("Tabelle1").Cells(100, 6)).Value"
Sorry für meine sehr einfache Fragen ich möchte den Code richtig verstehen weil mir wurde hier sehr oft geholffen.
Gerd Danke schön ich hoffe das ich es richtig beschrieben habe.
Gruß Becker

Hallo Becker!
Sub test()
Dim Wb As Workbook
For Each Wb In Application.Workbooks
Select Case Wb.Name
Case ThisWorkbook.Name
Case Else
If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then
With ThisWorkbook.Worksheets("Tabelle6").Range(ThisWorkbook.Worksheets("Tabelle6").Cells(1, 1), ThisWorkbook.Worksheets("Tabelle6").Cells(600, 6))
.ClearContents 'für Wiederholungen
.Value = Wb.Worksheets("Tabelle1").Range(Wb.Worksheets("Tabelle1").Cells(1, 1), Wb. _
Worksheets("Tabelle1").Cells(600, 6)).Value
End With
Exit For
End If
End Select
Next Wb
End Sub


Eine kleine Fehler bekomme ich in:
"With ThisWorkbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(100, 6))"
Laufzeitfehelr 9 Index außerhalb des gültigen Bereichs.


Ich habe es probiert mit "With Workbook.Worksheets("Tabelle1").Range(Cells(1, 1), Cells(100, 6))" dabei bekomme ich den Fehler 424 Objekt erforderlich

.
Mea culpa. Ich hatte den "Range" nicht vollständig wiederholend vor "Cells" eingesetzt.
Außerdem sollen die Werte ja nach Tabelle6 .
Dies habe ich geändert und den Bereich nach deiner letzten Mitteilung auf "A1:F600" geändert.


Was ich leider immer noch nicht verstehe in Deinen Code ist dass ich nicht sehe das er kopieren soll (nur die Werte).

Einzelne Zelleneigenschaften, hier "Value" kann man anderen Zellen auch direkt zuweisen,
bei größen- u. "form"-gleichen Bereichen geht dies am Stück mit der With - End With - Block-Anweisung.


Aber verstehe ich es hier richtig:
"If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then"
'wenn der "USA" in Tabelle1 in "B2" gefunden wurde(egal ob das die MappeF oder MappeG ist)

Ja, so hatte ich dich verstanden, dass "USA" insgesamt nur einmal vorkommen kann.
Daher der "Exit For" - Ausstieg aus der Schleife.
Ansonsten würde der Zielbereich bei diesem Code stets überschrieben werden.
Mit deshalb meine ersten Rückfragen.
Schauen wir mal.
Gruß Gerd

Sub test() Dim Wb As Workbook For Each Wb In Application.Workbooks Select Case Wb.Name Case ThisWorkbook.Name Case Else If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then With ThisWorkbook.Worksheets("Tabelle6").Range(ThisWorkbook.Worksheets("Tabelle6").Cells(1, _ 1), ThisWorkbook.Worksheets("Tabelle6").Cells(600, 6)) .ClearContents 'für Wiederholungen .Value = Wb.Worksheets("Tabelle1").Range(Wb.Worksheets("Tabelle1").Cells(1, 1), Wb. _ Worksheets("Tabelle1").Cells(600, 6)).Value End With ThisWorkbook.Worksheets("Tabelle6").Visible = True Exit For End If End Select Next Wb ThisWorkbook.Worksheets("Tabelle6").Visible = xlVeryHidden 'oder falls Blatt noch über die Menüleiste eingeblendbar sein soll: 'ThisWorkbook.Worksheets("Tabelle6").Visible = False End Sub

Sub test() Dim Wb As Workbook Dim intZähler As Integer For Each Wb In Application.Workbooks Select Case Wb.Name Case ThisWorkbook.Name Case Else intZähler = intZähler + 1 If intZähler = 11 Then Exit For If Wb.Worksheets("Tabelle1").Cells(2, 2).Value = "USA" Then With ThisWorkbook.Worksheets("Tabelle6").Range(ThisWorkbook.Worksheets("Tabelle6").Cells(1, _ 1), ThisWorkbook.Worksheets("Tabelle6").Cells(600, 6)) .ClearContents 'für Wiederholungen .Value = Wb.Worksheets("Tabelle1").Range(Wb.Worksheets("Tabelle1").Cells(1, 1), Wb. _ Worksheets("Tabelle1").Cells(600, 6)).Value End With ThisWorkbook.Worksheets("Tabelle6").Visible = True Exit Sub End If End Select Next Wb ThisWorkbook.Worksheets("Tabelle6").Visible = xlVeryHidden 'oder falss Blatt noch über die Menüleiste eingeblendbar sein soll: 'ThisWorkbook.Worksheets("Tabelle6").Visible = False End Sub

Beliebteste Forumthreads (12 Monate)

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread