Herbers Excel-Forum - das Archiv

Zellenbereich kopieren wenn Bedingung

Bild

Betrifft: Zellenbereich kopieren wenn Bedingung
von: Daniel

Geschrieben am: 05.01.2007 08:37:35
Hallo!
Ich möchter per VBA( andere Lösungen kommen nicht in Frage) die Zellen A-H vom Blatt "Quelle" zum Blatt "Ziel" kopieren, aber nur wenn in L oder M eine 1 steht.
In "Ziel" sollen die Einträge fortlaufend stehen, also immer in der nächsten Zeile und es sollen nur Inhalte kopiert werden.
Wie muss so ein Makro aussehen. Habe davon leider wenig Ahnung.
Danke für Hilfe!
Daniel
Bild

Betrifft: AW: Zellenbereich kopieren wenn Bedingung
von: Erich G.

Geschrieben am: 05.01.2007 09:43:41
Hallo Daniel,
wenn die Spalte N in "Quelle" frei ist und verwendet werden kann und wenn es keinen Autofilter gibt,
ginge das z. B. so:
Option Explicit
Sub Bestimmte_Saetze_kopieren()
' Quellspalten A bis M müssen in Zeile 1 Überschriften haben (ohne Lücken)
' Kopiert werden die Quellspalten 1 bis 8 der Zeilen,
'    in denen in Spalte L oder M (12 oder 13) die Zahl 1 steht.
' Quellspalte N (14) wird gelöscht.
Dim lngZ As Long
With Sheets("Quelle")
lngZ = .Cells(Rows.Count, 12).End(xlUp).Row
If lngZ < .Cells(Rows.Count, 13).End(xlUp).Row Then _
lngZ = .Cells(Rows.Count, 13).End(xlUp).Row
.Columns(14).Clear
.Cells(1, 14) = "xxx"
Range(.Cells(2, 14), .Cells(lngZ, 14)).FormulaR1C1 = "=((RC[-2]=1)+(RC[-1]=1))>0"
.Columns(14).AutoFilter
.Columns(14).AutoFilter Field:=1, Criteria1:=True
Range(.Cells(2, 1), .Cells(lngZ, 8)).Copy
End With
With Sheets("Ziel")
lngZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZ, 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With Sheets("Quelle")
.Columns(14).AutoFilter
.Columns(14).Clear
End With
End Sub
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht allen einen guten Start ins neue Jahr!
Bild

Betrifft: AW: Zellenbereich kopieren wenn Bedingung
von: Daniel
Geschrieben am: 05.01.2007 09:48:55
Hallo Erich,
einen Filter will ich nicht benutzen. Die Struktur des Blatts und die Reihenfolge der Daten muss unbedingt beibehalten werden.
Die Spalte I ist außerdem leer.
Danke,
Daniel
Bild

Betrifft: AW: Zellenbereich kopieren wenn Bedingung
von: Ramses
Geschrieben am: 05.01.2007 09:54:40
Hallo
Hast du den Beitrag von Erich überhaupt richtig gelesen ?
Ich empfehle:
Ausprobieren - Nachdenken - Dann Beitrag schreiben
Gruss Rainer
Bild

Betrifft: AW: Zellenbereich kopieren wenn Bedingung
von: Daniel
Geschrieben am: 05.01.2007 10:02:16
Hallo Rainer, hallo Erich!
Ich bitte vielmals um Entschuldigung. Ich hatte das falsch verstanden und daher nicht ausprobiert.
Es geht aber wie gewünscht!!!
Vielen, Vielen Dank daher!
Daniel
Bild

Betrifft: Danke für Rückmeldung - und neue Version
von: Erich G.

Geschrieben am: 05.01.2007 14:10:23
Hallo Daniel,
der Code war nur ein "Schön-Wetter"-Code - er läuft richtig, wenn in Spalte L oder M eine 1 steht, sonst produziert er Unsinn.
Deshalb hier eine verbesserte Version:
Option Explicit
Sub Bestimmte_Saetze_kopieren()
' Quellspalten A bis M müssen in Zeile 1 Überschriften haben (ohne Lücken)
' Kopiert werden die Quellspalten A-H (1-8) der Zeilen,
'    in denen in Spalte L oder M (12 oder 13) die Zahl 1 steht.
' Quellspalte N (14) wird gelöscht.
Dim lngZ As Long
With Sheets("Quelle")
lngZ = .Cells(Rows.Count, 12).End(xlUp).Row
If lngZ < .Cells(Rows.Count, 13).End(xlUp).Row Then _
lngZ = .Cells(Rows.Count, 13).End(xlUp).Row
If lngZ <= 1 Then Exit Sub
If WorksheetFunction.SumIf(Range(.Cells(2, 12), .Cells(lngZ, 13)), 1) = 0 Then Exit Sub
.Columns(14).Clear
.Cells(1, 14) = "xxx"
Range(.Cells(2, 14), .Cells(lngZ, 14)).FormulaR1C1 = "=1*(((RC[-2]=1)+(RC[-1]=1))>0)"
.Columns(14).AutoFilter
.Columns(14).AutoFilter Field:=1, Criteria1:=1
Range(.Cells(2, 1), .Cells(lngZ, 8)).Copy
End With
With Sheets("Ziel")
lngZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZ, 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
Sheets("Quelle").Columns(14).Clear
Sheets("Quelle").Columns(14).Clear
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
 Bild
Excel-Beispiele zum Thema "Zellenbereich kopieren wenn Bedingung"
Blätter in andere Arbeitsmappen kopieren Module von Mappe zu Mappe kopieren
Arbeitsblatt 40 mal kopieren Schriftgröße beim Kopieren verdoppeln
Beim Kopieren auch die Zeilenhöhe und Spaltenbreite übernehmen Tabellencode nach Kopieren des Blattes löschen
Arbeitsmappe blitzschnell kopieren VBE-Namen der Blattmodule beim Kopieren festlegen
Blattinhalt von einer zur anderen Arbeitsmappe kopieren Formel bis zur letzten Zeile der Nebenspalte kopieren