Office: Vba Wenn Bedingung erfüllt kopiere in ein anders Tabellenblatt

Hallo,
Ich hoffe das Ihr mir weiter helfen könnt.
Das Problem bei meiner Tabelle ist das ich es nicht hinbekomme mehrere Blätter in ein anders Blatt zu kopieren wenn in Spalte H der verschiedenen Blätter in irgendeiner Zelle ein x als Bedingung eingetragen wird.
Mit einem click auf ein Button soll erst das Tabellenblatt Ziel komplett geleert werden dann in Kunde1 und in Kunde2 überprüft werden ob in Spalte H ein x steht. Wenn das der Fall ist soll er mir die ganze Zeile kopieren und unternander in das Tabellenblatt Ziel einfügen. Ich habe in meiner Original Tabelle etwa 60 Tabellenblätter mit Kundennamen wo das Makro überprüfen soll ob in Spalte H ein x steht und alle die Zellen mit dem x dann in das Tabellenblatt Ziel kopiert.
Ich hoffe Ihr könnt mir bei meinem Problem weiter helfen.
Wünsche euch ein frohes Weihnachtsfest und ein guten Rutsch.

 

Benutze Autofilter und Kopiere den sichtbaren Bereich, Start, Bearbeiten, Suchen..., Gehe zu, Inhalte, sichtbare Zellen.
Excel hat auch einen Makrorecorder.

Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue. Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Bilder statt Datei | Excel ist sexy!

Es sollte ein aussagekräftiger Name sein.

Das ist nur meine Meinung zu dem Thema.

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
Hinweis - Anonymisierung und Pseudonymisierung von Beispielmappen - MS-Office-Forum
ändern.

Das ist nur meine Meinung zu dem Thema.

 

ausversehen Doppelt

 

Hallo,

in der beiliegenden Excel-Datei habe ich dir ins Codemodul des Arbeitsblattes "Ziel" nachfolgendes Makro eingefügt.
Sobald du in Zelle A1 des Arbeitsblattes "Ziel" ein Doppelklick ausführst, werden
1) die Inhalte von Arbeitsblatt "Ziel" gelöscht
2) alle Kundenarbeitsblätter durchsucht, ob sie in Spalte "H" einen "x"-Wert aufweisen. Falls ja, wird die Zeile mit dem "x" kopiert und in die nächste freie Zeile des Arbeitsblattes "Ziel" angefügt.
3) Da du keine Angaben gemacht hast, wie ein Kundenarbeitsblatt zu erkennen ist, nimmt das Makro an, dass ein solches Blatt in Zelle A1 das Wort "Kunde" enthält.

Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
  If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
 
  Dim lngZeile As Long
  Dim Ws As Worksheet
  Dim rngZelleX As Range
 
 
  '1a) Lösche alle Zellinhalte im Arbeitsblatt "Ziel"
  Me.Cells.Clear
  '1b) Lege die Nummer der letzten Datenzeile im Arbeitsblatt "Ziel" fest:
  lngZeile = 0
 
  '2) Überprüfe alle Kundenarbeitsblätter, ob sie irgendwo in Spalte H ein "x" stehen haben
  For Each Ws In ThisWorkbook.Worksheets
 
      '2a) Teste, ob es ein Kundenarbeitsblatt ist:
      '    Das ist der Fall (mangels präziserer Angaben), wenn in Zelle A1 eines Arbeitsblattes das Wort "Kunde" steht
      If Ws.Range("A1").Value = "Kunde" Then
    
         '2b) Überprüfe, ob in Spalte H dieses Arbeitsblattes ein "x" steht
         Set rngZelleX = Ws.Cells.Find(What:="x", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)
         If Not rngZelleX Is Nothing Then
           '2c) "rngZelleX" ist die Zelle aus Spalte H mit einem "x"-Wert
 
           '3) Kopiere die Zeile mit dem "x" und füge sie im Arbeitsblatt "Ziel" unter die letzte Datenzeile ein.
           '3a) Nummer der nächsten freien Datenzeile im Blatt "Ziel"
           lngZeile = lngZeile + 1
           '3b) Kopiere die Quellzeile in die Zielzeile, beginnend in Spalte A von Zeilennr. "rngZeile":
           rngZelleX.EntireRow.Copy Destination:=Me.Cells(lngZeile, 1)
         End If
      End If
  Next Ws

End Sub

 

Hallo,
sorry habe jetzt erst die möglichkeit gehabt dein Makro auszuprobieren.

Es ist genau das was ich gesucht habe , Danke dafür.

Habe nur das Problem das ich es jetzt auf meiner Original Mappe1 anpassen muss.
Zum Beispiel :Wie ändere ich das suchen in Spalte H ?
Muss in der Original Mappe in Spalte Z nach x suchen.
Da nur Dim rngZelleX As Range angegeben ist weiss ich nicht wie man in Spalte Z suchen kann.
Sorry für meine unwissenheit , bin halt noch Anfänger.
Um richtig dahinter zu steigen wird es noch eine Weile dauern.

Lg Christian

 

Hallo Christian,

ich muss leider zugeben, dass ich in meinem Makro ein Detail übersehen habe: So wie das Makro von Posting #4 ist, sucht es im gesamten Arbeitsblatt nach dem Wert "x" und nicht bloß in der Spalte H. Damit es das tut, ist in der Zeile mit der Find(...)-Funktion das Wort Cells durch das Wort Columns("H") zu ersetzen.
Damit das Makro nur jeweils in der Spalte Z sucht (nach deinen letzten Wünschen), muss diese Makrozeile lauten:
Set rngZelleX = Ws.Columns("Z").Find(What:="x", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)

 

Hallo,

Danke, die Änderung hat funktioniert.

Nur das das Makro immer nur pro Blatt eine Zeile kopiert wo in Spalte Z ein x drin ist.
Ich habe zum Beispiel in Tabellenblatt "KUNDE1,2,3,4...u.s.w" zwei oder mehr Zeilen die mit einem x in Spalte Z versehen sind.
Kopieren tut das Makro aber immer nur eine Zeile in der ein x ist .
Weitere Zeilen mit dem x im gleichen Tabellenblatt läst es aus und kopiert nichts.

Könnst du mir da nochmal aushelfen.

Lg
Christian

 

Hallo Christian,

in der beiliegenden Excel-Datei habe ich dir den Mechanismus zum Ermitteln von Mehrfachfunden pro Arbeitsblatt in Spalte Z eingebaut. Der folgende VBA-Code ist auch in der Datei enthalten.

Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
  If Intersect(Target, Me.Range("A1")) Is Nothing Then Exit Sub
 
  Dim lngZeile As Long
  Dim Ws As Worksheet
  Dim rngZelleX As Range, strAdresseErstesX As String
 
  '1a) Lösche alle Zellinhalte im Arbeitsblatt "Ziel"
  Me.Cells.Clear
  '1b) Lege die Nummer der letzten Datenzeile im Arbeitsblatt "Ziel" fest:
  lngZeile = 0
 
  '2) Überprüfe alle Kundenarbeitsblätter, ob sie irgendwo in Spalte Z ein "x" stehen haben
  For Each Ws In ThisWorkbook.Worksheets
 
      '2a) Teste, ob es ein Kundenarbeitsblatt ist:
      '    Das ist der Fall (mangels präziserer Angaben), wenn in Zelle A1 eines Arbeitsblattes das Wort "Kunde" steht
      If Ws.Range("A1").Value = "Kunde" Then
   
         '2b) Überprüfe, ob in Spalte Z dieses Arbeitsblattes ein "x" steht
         Set rngZelleX = Ws.Columns("Z").Find(What:="x", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)
         If Not rngZelleX Is Nothing Then
           '2c) Es existiert eine Zelle aus Spalte Z mit einem "x"-Wert: rngZelleX
           '2d) Merke dir die Adresse dieses 1. Fundes
           strAdresseErstesX = rngZelleX.Address
           Do
              '3) Kopiere die Zeile mit dem "x" und füge sie im Arbeitsblatt "Ziel" unter die letzte Datenzeile ein.
              '3a) Nummer der nächsten freien Datenzeile im Blatt "Ziel"
              lngZeile = lngZeile + 1
              '3b) Kopiere die Quellzeile in die Zielzeile, beginnend in Spalte A von Zeilennr. "rngZeile":
              rngZelleX.EntireRow.Copy Destination:=Me.Cells(lngZeile, 1)
           
              '4a) Suche nach dem nächsten "x"-Wert in Spalte Z;
              '    falls das Spaltenende erreicht wurde, beginne wieder am Anfang der Spalte "Z" zu suchen
              Set rngZelleX = Ws.Columns("Z").FindNext(After:=rngZelleX)
              '4b) Falls die Zelle "rngZelleX" bereits 1x gefunden wurde, brich die Suche ab
           Loop Until rngZelleX.Address = strAdresseErstesX
         End If
      End If
  Next Ws

End Sub

 

Hallo,
Hab dein Makro ausprobiert.
Vielen Dank für deine Hilfe
Makro tut was es tun soll

Lg
Christian