Office: (Office 2007) Wenn bestimmter Wert dann komplette Zeile kopieren

Hallo zusammen,
ich habe ein Problem für das ich hier noch keine Lösung gefunden habe.
Ich habe eine Exceldatei mit drei Tabellenblättern.
Master - Tabelle 1 - Tabelle 2
Tab. 1und2 sollen im Master suchen.
Steht also jetzt im Master in Spalte B das Wort "Störung" dann soll er alle Zeilen in denen das vorkommt komplett (also Spalte A-X) in Tabelle 1 kopieren.

Tabelle 2 sucht nach Wartung. Steht also im Master in Spalte B irgendwo Wartung, soll er auch die Zeilen (von A-X) in Tabelle 2 kopieren.

das müsste doch eigentlich mit einer Wenn/Dann Funktion gehen oder?

Ich hoffe auf Antworten und bedanke mich schonmal vorab.

Gruß
DJ

:)

 

Hi,

probier mal.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub copyRows()
Dim shtSrc As Worksheet, shtTarget As Worksheet
Dim rng As Range
Dim strFirst As String, strSearch() As Variant, strSheets() As Variant
Dim lngIndex As Long

'Suchgbegriffe
strSearch = Array("Wartung", "Störung")
'Tabellen in der Reihenfolge der Suchbegriffe
strSheets = Array("Tabelle1", "Tabelle2")

Set shtSrc = Sheets("Master")

With shtSrc
For lngIndex = 0 To UBound(strSearch)
strFirst = ""
Set rng = Nothing
Set shtTarget = Sheets(strSheets(lngIndex))

Set rng = .Range("B:B").Find(What:=strSearch(lngIndex), LookAt:=xlPart, LookIn:=xlValues, MatchCase:=False)

If Not rng Is Nothing Then
strFirst = rng.Address
Do
rng.EntireRow.Copy shtTarget.Cells(shtTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Set rng = .Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
End If
Next
End With

Set rng = Nothing
Set shtTarget = Nothing
Set shtSrc = Nothing
End Sub

 

Hallo DJ,

das ist eher eine VBA-Angelegenheit:

Sub Kopieren()

dim loZeile1 as long
dim loZeile2 as long
dim loZeile3 as long
dim loCount1 as long
dim wks1 as worksheet
dim wks2 as worksheet
dim wks3 as worksheet

set wks1 = Sheets("Master")
set wks2 = Sheets("Tabelle1")
set wks3 = Sheets("Tabelle2")

loZeile1= wks1.cells(rows.count,2).end(xlup).row
loZeile2= wks2.cells(rows.count,2).end(xlup).row+1
loZeile3= wks3.cells(rows.count,2).end(xlup).row+1

For loCount1= 1 To LoZeile1
With wks1
If .Cells(loCount1, "B") = "Störung" Then
.Rows(LoCount1).Copy _
Destination:=wks2.Rows(LoZeile2)
loZeile2 = loZeile2 +1
End If
If .Cells(loCount1, "B") = "Wartung" Then
.Rows(LoCount1).Copy _
Destination:=wks3.Rows(LoZeile3)
loZeile3 = loZeile3 +1
End If
end With

end sub

Eine Möglichkeit, allerdings ungetestet.

 

Hi DiskJockey,

in A1 der Tabelle1 steht folgende Arrayformel:
{=WENN(ZÄHLENWENN(Master!$B:$B;"Störung") < ZEILE(A1);"";INDEX(Master!A:A; KKLEINSTE(WENN(Master!$B$1:$B$99="Störung";ZEILE($1:$99));ZEILE(A1))))}
nach rechts und nach unten kopieren

ARRAY-Formel {=geschweifte Klammern} nicht eingeben;
Abschluß der Formel mit gleichzeitig Strg / Shift / Enter (statt Enter allein); - das erzeugt sie.

Tabelle2 dann analog mit "Wartung".

Salut WF

 

Hallo WF,

mir scheint an der "Elite"-Uni Karlsruhe (KIT!) konnte man doch mal was lernen. Echt gut.

 

GENIAL!!!

Danke. Das ist ja einfach und genau das was ich gesucht habe.

DANKE! DANKE!

Gruß
DJ

 

Hallo,
ich habe ein ähnliches Problem.
In einem Tabellenblatt werden Rechnungsdaten zu verschiedenen Projekten gesammelt. Anhand des Projektnamens oder der Projektnummer (Werte der Spalte E oder F) sollen entsprechende neue Tabellenblätter angelegt und die jeweilige Zeile in das neu angelegte Datenblatt kopiert werden. Es sollen also im Prinzip automatisch Tabellen zu den jeweiligen Projekten angelegt werden in die sich die Rechnungsdaten automatisch einsortieren.
Habe es schon mit folgendem Script versucht, aber das Problem ist, dass jeweils nur ein Eintrag pro generiertem Tabellenblatt angelegt wird:

Sub DatenInExtraBlatt()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngLZQ As Long
Dim lngLZZ As Long
Dim zell As Range
Dim Dic As Object
Dim keyD As Variant

Set Dic = CreateObject("Scripting.Dictionary")
Set wksQ = Worksheets("Tabelle1") 'ggf. ANPASSEN

For Each wksZ In Worksheets
Dic(wksZ.Name) = ""
Next

lngLZQ = wksQ.Cells(wksQ.Rows.Count, 3).End(xlUp).Row '3=SpalteC

For Each zell In wksQ.Range("C2:C" & lngLZQ)
If zell.Value "" Then
If Not Dic.Exists(zell.Value) Then
Dic(zell.Value) = "clear"
Set wksZ = Worksheets.Add(After:=Sheets(Sheets.Count))
wksZ.Name = zell.Value
Else
Set wksZ = Worksheets(zell.Value)
If Dic(zell.Value) "clear" Then
Dic(zell.Value) = "clear"
wksZ.UsedRange.Clear 'Zieltabelle säubern
End If
End If
lngLZZ = wksZ.Cells(wksZ.Rows.Count, 3).End(xlUp).Row '3=SpalteC
zell.EntireRow.Copy wksZ.Range("A" & lngLZZ + 1)
End If
Next

En

Von Visual Basic habe ich keine Ahnung. Vielleicht kann mir ja jemand helfen.

 

Hallo!
Ich bin etwas spät dran, mich interessiert dieser Code ganz besonders. Ich habe aber ein Problem mit der Zeile mit der EntireRow.Copy- Anweisung. Ich möchte, daß nur Werte kopiert werden, nicht Formeln. Wie kann ich daß umsetzen?

Für eine Antwort wäre ich sehr dankbar!

HALIGO

 

Hallo HALIGO
Mit Pastespecial.
Code:

gruss hary

 

Hallo,
ich habe eine Frage zu Josef e´s Code.
Der Code funktioniert bei mir wunderbar.
Ich nutze Ihn um festzustellen, welche Aufträge die Artikelnummer X beinhalten.
Nachdem ich den Code angewendet habe, erkenne ich, dass es ca 800 Aufträge sind in denen diese Artikelnummer vorkommt.
Es sind also auch 800 verschiedene Auftragsnummern.
Und jetzt die Herausforderung:
Die Auftragsnummern in der Mastertabelle Spalte B sollen mit den Auftragsnummern in Tabelle1 Spalte A abgeglichen werden. Wenn die Auftragsnummer in der Mastertabelle und in Tabelle 1 vorkommt, dann soll(en) die komplette(n) Zeile(n) in der Mastertabelle stehen bleiben. Falls die Auftragsnummer nicht in der Tabelle1 vorkommt, soll(en) die komplette(n) Zeile(en) in der Mastertabelle gelöscht werden.
Mein Ziel ist es festzustellen, was zudem an Artikeln versendet wurde, wenn im Auftrag die Artikelnummer X vorkommt.

Ich hoffe ihr könnt mir helfen.
Grüße dapaco

 

Ich krame dieses ältere Thema mal wieder aus (habe bisher nur mitgelesen und schon viel lernen dürfen), da ich im Moment nicht weiterkomme:

Habe die Array Formel von W_F verwendet was auch ausgezeichnet funktioniert hat. Excel kopiert mir nun alle Spalten aus Sheet 1 wenn in Spalte J eine 1 steht in Sheet 2.

=WENN(ZÄHLENWENN('Sheet1'!$J:$J;"1")

 

Hallo liebe Mitstreiter,

auch ich (= Null-VBA-Kenntnis - Excel = geht so) habe ein ähnliches Problem, das mir fast sämtliche Haare ergrauen lässt - please help me!:

Ich führe ein Handelsjournal. Dieses zieht sich die Daten über die Indirekt-Funktion aus einzelnen Dokumentationsdateien (bspw. 1.xlsx, 2.xlsx, usw.).
Wenn ich diese Dokumentationsdateien schließe, so hat die Handelsjournal-Datei keinen Bezug mehr und folglich auch keine Werte.
Folglich bin ich dazu übergegangen nicht die Formeln, sondern den Inhalt der Handelsjournal-Datei (siehe Arbeitsblatt "Umsetzer") - während die einzelne Dokumentsdatei noch geöffnet ist - zu kopieren und die Inhalte in ein zweites Handelsjournal-Arbeitsblatt (siehe Arbeitsblatt "Journal") einzufügen.

Dies ist auf Dauer ziemlich umständlich.

Meine "Programmierversuche" hatten bislang mein Wunschziel verfehlt.

Dieses Wunschziel lautete:

Wenn die Handelsjournal einen Bezug hat, so kopiere mir den Inhalt der kompletten Zeile ab Spalte D und füge diesen unter der richtigen Trade-Nr. automatisch in das zweite Handelsjournal-Arbeitsblatt ab Spalte D ein.
Wenn Sie keinen Bezug hat, so lasse den Inhalt in dem Journal unverändert.

Ich würde mich unheimlich freuen, wenn ihr mein Anliegen verstehen und mir Lösungsansätze zu der angehängten Datei liefern könntet.

Danke im Voraus!

 

Moin Peter
Excel hat auch eine Makrorecorder, der hilft schon mal im Ansatz. ;-)
In groben Zuegen sollte das klappen.
Code:

gruss hary

 

Moin Harry,

danke für die rasche Rückantwort.

Leider kopiert er den Bezug mit und löscht auch die bereits existenten Daten, d. h. wenn ich 1.xls schließe und 3.xls öffne, dann löscht er im Journal auch die 1.xls und weist "keinen Bezug" aus.

Zudem sollte - das habe ich leider nicht beachtet - sämtliche Übertragung erst mit der Zeile 4 beginnen.

bG
Peter

 

Hierfür habe ich Deine Formel folgendermaßen abgeändert:

Sub Ansatz()
Dim letzte As Long
With Worksheets("Umsetzer")
If .Range("D4").Text "#Bezug!" Then
letzte = .Cells.SpecialCells(xlLastCell).Row
.Range("D4:N" & letzte).Copy
Sheets("Journal").Range("D4").PasteSpecial Paste:=xlPasteValues
End If
End With
Application.CutCopyMode = False
End Sub

Wäre es möglich ggf. eine weitere Schleife oder einen Mechanismus einzubauen, so dass er den "Bezug" nicht zieht?