Makro nach Bedingung laufen lassen

Hallo Leute,
verzeiht mir bitte, dass ich einen neuen Thread für mein Thema eröffne, aber irgendwie werde ich, wenn ich den Link meines ursprünglichen Threads in meiner Mail anklicke, auf einen anderen Thread weitergeleitet. Ich kann nur noch auf den Archivthread zugreifen: https://www.herber.de/forum/archiv/1712to1716/t1714436.htm
Ich versuche mal mein Problem nochmals so gut es geht zu schildern und auf den letzten Beitrag von Daniel zu antworten.
Ich habe ein Makro vor mir, welches Daten aus einer Tabelle kopiert und in eine andere Tabelle im gleichen Arbeitsblatt schreibt. Ich habe eine Beispieldatei unter folgendem Link hochgeladen: https://www.herber.de/bbs/user/132326.xlsx
In diesem Beispiel sollen die Daten aus den Spalten Z AK mit Ausnahme von der Spalte AE Obstsorte in die Spalten A K geschrieben werden. Das Kopieren der Daten und das Einfügen in die Spalten A K ist nicht das Problem, das funktioniert.
Bisher wird die Spalte AE nicht beachtet und ist nicht von Bedeutung für das Makro. Das versuche ich zu ändern. Ich möchte, dass sich das Makro zuerst die Spalte AE ansieht und den Code nur auf die Zeilen anwendet, in denen, wie in diesem Beispiel Apfel steht. Datensätze mit Orange, Traube, etc. werden zurzeit noch mitkopiert, diese sollen in Zukunft aber ignoriert werden.
Vielleicht kann mir ja mit diesen Informationen jemand damit helfen. Falls nicht versuche ich zur Not noch irgendwie etwas vom Makro zu zeigen.
LG Nick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Test() Dim wsQ As Worksheet, wsZ As Worksheet Dim loLetzteQ As Long Set wsQ = Worksheets("Tabelle1") Set wsZ = Worksheets("Tabelle2") Application.ScreenUpdating = False With wsQ loLetzteQ = .Cells(.Rows.Count, "AE").End(xlUp).Row .Range(.Cells(17, "Z"), .Cells(loLetzteQ, "AK")).AutoFilter Field:=6, Criteria1:="Apfel" With .AutoFilter.Range .Offset(1).Resize(.Rows.Count - 1).Copy wsZ.Range("A1").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End With If .AutoFilterMode Then .AutoFilterMode = False wsZ.Columns(6).Delete End With Set wsQ = Nothing: Set wsZ = Nothing End Sub

Hallo Werner und Peter,
vielen Dank an euch beide, aber leider konnte ich nicht das gewünschte Ergebnis erzielen, aber das liegt sehr wahrscheinlich an meinen gelieferten Informationen.
Die Spalten, die kopiert werden sollen, werden nicht anhand des Spaltenbuchstabens kopiert, weil sich die Plätze der Spalten in der Tabelle ändern können. Ich zeige euch mal einen Ausschnitt des Codes. Ich versuche die Funktion zur Auswahl der Datensätze Apfel zwischen diese beiden Funktionen einzubauen. Die Bezeichnungen zwischen den Anführungszeichen "" habe ich mal verändert. Ich hoffe, es ist so dennoch verständlich. Die Funktion zum Löschen der leeren Zeilen funktioniert auch so, wie es soll. Hoffentlich kann das zum besseren Verständnis beitragen.
LG Nick

Sub test()
'Hier werden die leeren Zeilen gelöscht
Dim Treffer0 As Range
With Tabelle1
Set Treffer0 = Rows(2).Find(what:="SpalteZ", lookat:=xlWhole)
Columns(Treffer0.Column).SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Select
Selection.Delete Shift:=xlUp
Sheets("TabelleX").Select
Rows("1:1").Select
Selection.Copy
Sheets("Dieses Tabellenblatt").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
End With
'Ab hier werden die Spalten, die kopiert werden soll, anhand des Spaltennamens gesucht und  _
kopiert
Dim Treffer1 As Range
With Tabelle1
Set Treffer1 = Rows(2).Find(what:="SpalteX", lookat:=xlWhole)
Dim SpalteX As Range
Set SpalteX = .Rows(1).Find(what:="SpalteX", lookat:=xlWhole)
If Treffer1 Is Nothing Then
MsgBox "SpalteX nicht gefunden."
Else
Columns(Treffer1.Column).Select
Selection.Copy
Columns(Betreiber.Column).Select
ActiveSheet.Paste
'MsgBox "SpalteX eingefuegt"
End If
End With

Option Explicit Public Sub Versuch() Dim strSuch1 As String, strSuch2 As String Dim loLetzte As Long, raFund As Range strSuch1 = "Obstsorte" strSuch2 = "Apfel" Application.ScreenUpdating = False With Worksheets("Tabelle1") Set raFund = .Rows(2).Find(what:=strSuch1, LookIn:=xlValues, lookat:=xlWhole) If Not raFund Is Nothing Then loLetzte = .Cells(.Rows.Count, raFund.Column).End(xlUp).Row If WorksheetFunction.CountIf(.Range(.Cells(2, raFund.Column), _ .Cells(loLetzte, raFund.Column)), strSuch2) > 0 Then .Range(.Cells(2, "Z"), .Cells(loLetzte, "AK")).AutoFilter _ Field:=raFund.Column - 25, Criteria1:=strSuch2 With .AutoFilter.Range .Offset(1).Resize(.Rows.Count - 1).Copy _ Worksheets("Tabelle2").Range("A1") End With Worksheets("Tabelle2").Columns(raFund.Column - 25).Delete If .AutoFilterMode Then .AutoFilterMode = False Else MsgBox strSuch2 & " ist in Spalte " & raFund.Value & " nicht vorhanden." End If Else MsgBox strSuch1 & " wurde in der Überschriftenzeile nicht gefunden." End If End With Set raFund = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Makro nach Bedingung laufen lassen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread