Bestimmte Zellen in ein anderes Blatt kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Verteilen() Dim TBU, TBE, TBQ, TBO, SP As Integer, Blatt, ArrE, ArrB Set TBU = Sheets("Übersicht") Set TBE = Sheets("E&M") Set TBQ = Sheets("QM") Set TBO = Sheets("OP") ArrE = Array("PE", "Q", "O") ArrB = Array(TBE.Name, TBQ.Name, TBO.Name) With TBU If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten For Blatt = Lbound(ArrE) To Ubound(ArrE) 'filtern .Range("$A1:$E99").AutoFilter Field:=5, Criteria1:=ArrE(Blatt) 'reset Sheets(ArrB(Blatt)).UsedRange.ClearContents 'gefilterte Zeilen copieren Intersect(.Range("A:C"), .Cells(1, 1).CurrentRegion.SpecialCells(xlCellTypeVisible)).Copy _ Sheets(ArrB(Blatt)).Cells(1.1) 'Sortieren With Sheets(ArrB(Blatt)).Sort .SortFields.Clear .SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:C") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Next .AutoFilterMode = False ' Autofilter ausschalten End With End Sub

Hallo
ich denke die Beispieldatei reicht aus das Problem zu lösen. Bitte zuerst die Originaldaten ins Beispiel kopieren und dort testen.
Im Beispiel kann man kein Originaldaten zerstören! Jedes Makro könnte vor dem Test noch Fehler enthalten.
Die alten Daten in ESM, OP, QM werdn immer gelöscht. Ich hoffe das ist so richtig? Sortieren braucht man nicht, weil ich denke das Spalte A schon eine fortlaufend Nummer hat! Im Makro ist dieser Befehl vorgesehen, zur Zeit aber durch das ' Zeichen nicht wirksam!
'ESM.Cells(s, 1) = s - 1 'Lauf-Nr 1-n
Wenn man das ' Zeichen entfernt wird eine fortlaufend Nummer von 1-n erzeugt, sonst steht in Spalte A die aktuelle Lauf Nummer aus der Übersicht. Ich denke das Programm ist so einfach geschrieben das man nicht viel erklaren muss.
Würde mich freuen wenn es die Aufgabe erfüllt.
https://www.herber.de/bbs/user/129839.xlsm
mfg Piet

Hallo
mein Vorschlag ist, das Button Makro im Modul1 zu belassen, es stört ja nicht. Hier eine neue Version!
Sie gehört NICHT in ein Modul, sondern direkt ins Code Blatt für Tabelle "Übersicht". Einfach im VBA Editor die Tabelle anklicken, und den Code ins Blatt reinkopieren. Fertig!
Dieser Code laeuft über Target Funktion, d.h., bei jeder Eingabe in Spalte E wird geprüft ob der Wert in die anderen Tabellen kopiert werden muss. Dann wird er fortlaufend unten angehangen! Viel Spass beim Testen ...
mfg Piet

Option Explicit
Dim Sht As Worksheet, t, lz1 As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'Target nur bei Eingabe in Spalte E aktiv
If Target.Column = 5 Then
t = Target.Row  'akt. Zeile
If Target.Value = "oe" Then Target.Value = "O"
If Target.Value = "q" Then Target.Value = "Q"
If Target.Value = "pe" Then Target.Value = "PE"
If Target.Value = "PE" Then
Set Sht = Worksheets("ESM")
lz1 = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(t, 1).Resize(1, 3).Copy Sht.Cells(lz1, 1)
'Sht.Cells(s, 1) = lz1 - 1  'Lauf-Nr 1-n
ElseIf Target.Value = "O" Then
Set Sht = Worksheets("OP")
lz1 = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(t, 1).Resize(1, 3).Copy Sht.Cells(lz1, 1)
'Sht.Cells(s, 1) = lz1 - 1  'Lauf-Nr 1-n
ElseIf Target.Value = "Q" Then
Set Sht = Worksheets("QM")
lz1 = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(t, 1).Resize(1, 3).Copy Sht.Cells(lz1, 1)
'Sht.Cells(s, 1) = lz1 - 1  'Lauf-Nr 1-n
End If
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Bestimmte Zellen in ein anderes Blatt kopieren

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bestimmte Zellen in ein anderes Blatt kopieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

311 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread