Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen nach Kriterium automatisch kopieren

Zellen nach Kriterium automatisch kopieren
Matthias
Hallo zusammen,
ich würde gerne folgende Aufgabe über ein Makro lösen
Ein Tabellenblatt enthält eine Nummer in C3, dieser Nummer sind in weiteren Spalten (A3, B3, D3,...) Werte zugeordnet.
Wenn nun beispielsweise in C100 die gleiche Nummer wie in C3 eingegeben wird, sollen die Werte aus A3, B3, D3, ... automatisch in A100, B100, D100 übernommen werden.
Von der Logik her:
Wenn Wert in Spalte C eingegeben wird prüfen ob Wert bereits schon mal vorhanden ist
wenn ja in welcher Zeile ist der Wert vorhanden.
Werte der Spalten A, B, D,... in dieser Zeile kopieren und in die Zeile einfügen in der gleiche Wert wie in Spalte C gerade eingegeben wurde.
ABER: wie setzt man das in VBA um ?
Erstmal Danke fürs Frage lesen!
Hoffe einer von euch kann mir helfen.
Grüße
Matthias

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellen nach Kriterium automatisch kopieren
07.08.2009 12:59:15
Rudi
Hallo,
in das Klassenmodul der Tabelle:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Long
If Target.Column = 3 Then
If Application.CountIf(Columns(3), Target) > 1 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
n = Application.Match(Target, Columns(3), 0)
Range(Cells(n, 1), Cells(n, 4)).Copy Target.Offset(, -2)
End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub

Gruß
Rudi
AW: Zellen nach Kriterium automatisch kopieren
07.08.2009 13:39:45
Matthias
Hallo Rudi,
vielen Dank für die rasche Antwort! Funktionert!
Eine Frage habe ich noch:
Wenn ich nur bestimmte Zellen kopieren will (beispielsweise A3, B3, E3, F3, J3).
Was muss ich ändern?
Ich verstehe die Zeile
Range(Cells(n, 1), Cells(n, 2)).Copy Target.Offset(, -2)
leider nicht.
Vielen Dank nochmal fürs erste.
Grüße
Matthias
Anzeige
AW: Zellen nach Kriterium automatisch kopieren
07.08.2009 13:50:18
Rudi
Hallo,
dann kannst du die Zellen einzeln kopieren.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Long
If Target.Column = 3 Then
If Application.CountIf(Columns(3), Target) > 1 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
n = Application.Match(Target, Columns(3), 0)
Cells(n, 1).Copy Target.Offset(, -2)
Cells(n, 2).Copy Target.Offset(, -1)
Cells(n, 5).Copy Target.Offset(, 3)
Cells(n, 6).Copy Target.Offset(, 4)
Cells(n, 10).Copy Target.Offset(, 8)
End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub

Gruß
Rudi
Anzeige
AW: Zellen nach Kriterium automatisch kopieren
07.08.2009 14:01:54
Matthias
Vielen Dank,
Damit ist das ganze erledigt!
Grüße
Matthias

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige