Zellen in andere Tabellenblätter kopieren

Hallo!
Ich möchte gerne Zellen aus einem Tabellenblatt in mehrere Tabellenblätter kopieren, wenn bestimmte Bedingungen zutreffen.
Das Tabellenblatt, in dem die Zellen zu Anfangs sind heißt "WL-Output".
Die anderen Tabellenblätter heißen "Buy","PT" und "SL".
Zunächst sollen die Zellen A1 bis H1 in die anderen drei Blätter kopiert werden.
Dann sollten in den drei Blättern die Spalte A-H gelöscht werden.
So, nun zu den eigentlichen Zellen und deren Bedingungen.
Aus dem Blatt "WL-Output" sollen dann alle Zellen der jeweiligen Zeile in den Spalten A-H in die jeweiligen Zellen A-H (also A2=A2 des anderen Blattes) des Blattes "Buy" kopiert werden, wenn in der Spalte D das Wort Buy steht und in der Spalte H eine leere Zelle ist.
Steht in Spalte D in der jeweiligen Zelle das Wort Sell und in der Zelle der Spalte H PT, so sollen die jeweiligen Zellen der Spalten A-H in das Blatt PT kopiert werden.
Steht in Spalte D in der jeweiligen Zelle das Wort Sell und in Spalte H SL, so sollen die Zellen ins Blatt "SL" kopiert werden.
Ich hoffe ich konnte das alles verständlich erklären was ich will.
Füre eure Hilfe wäre ich sehr dankbar.
Grüße,
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus!
Versuchs mal so:


Sub kopieren()
Application.ScreenUpdating = False
Worksheets("Buy").Range("A:Z").Value = "" 'Ich gehe hier davon aus, das max. bis Spalte
'Z belegt ist
Worksheets("PT").Range("A:Z").Value = ""
Worksheets("SL").Range("A:Z").Value = ""
Worksheets("WL-Output").Range("A1:H1").Copy
Worksheets("Buy").Range("A1").Select
ActiveSheet.Paste
Worksheets("PT").Range("A1").Select
ActiveSheet.Paste
Worksheets("SL").Range("A1").Select
ActiveSheet.Paste
Worksheets("WL-Output").Select
endupWL = Range("A65536").End(xlUp).Row
For i = 2 to endupWL
If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "" Then
endupBuy = Worksheets("Buy").Range("A65536").End(xlUp).Row
Range("A" & i & ":H" & i).Copy
Worksheets("Buy").Select
Range("A" & endupBuy).Select
ActiveSheet.Paste
Worksheets("WL-Output").Select
End If
If Range("D" & i).Value = "Sell" and Range("H" & i).Value = "PT" Then
endupBuy = Worksheets("PT").Range("A65536").End(xlUp).Row
Range("A" & i & ":H" & i).Copy
Worksheets("Buy").Select
Range("A" & endupBuy).Select
ActiveSheet.Paste
Worksheets("WL-Output").Select
End If
If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "SL" Then
endupBuy = Worksheets("SL").Range("A65536").End(xlUp).Row
Range("A" & i & ":H" & i).Copy
Worksheets("Buy").Select
Range("A" & endupBuy).Select
ActiveSheet.Paste
Worksheets("WL-Output").Select
End If
Next i
Application.ScreenUpdating = True
End Sub

Ist zwar nicht die eleganteste Loesung, sollte aber funktionieren (konnts leider nicht testen, da du ja keine Beispieldateien hochgeladen hast).
Ich hoffe, ich konnte dir helfen.
Gruss

Tobias

Sub kopieren() Application.ScreenUpdating = False Worksheets("Buy").Range("A:Z").Value = "" 'Ich gehe hier davon aus, das max. bis Spalte 'Z belegt ist Worksheets("PT").Range("A:Z").Value = "" Worksheets("SL").Range("A:Z").Value = "" Worksheets("WL-Output").Range("A1:H1").Copy Worksheets("Buy").Range("A1").Select ActiveSheet.Paste Worksheets("PT").Range("A1").Select ActiveSheet.Paste Worksheets("SL").Range("A1").Select ActiveSheet.Paste Worksheets("WL-Output").Select endupWL = Range("A65536").End(xlUp).Row For i = 2 to endupWL If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "" Then endupBuy = Worksheets("Buy").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("Buy").Select Range("A" & endupBuy + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Sell" and Range("H" & i).Value = "PT" Then endupPT = Worksheets("PT").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("PT").Select Range("A" & endupPT + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "SL" Then endupSL = Worksheets("SL").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("SL").Select Range("A" & endupSL +1 ).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If Next i Application.ScreenUpdating = True End Sub

Sub kopieren() Application.ScreenUpdating = False Worksheets("Buy").Range("A:Z").Value = "" 'Ich gehe hier davon aus, das max. bis Spalte 'Z belegt ist Worksheets("PT").Range("A:Z").Value = "" Worksheets("SL").Range("A:Z").Value = "" Worksheets("WL-Output").Range("A1:H1").Copy Worksheets("Buy").Activate Range("A1").Select ActiveSheet.Paste Worksheets("PT").Activate Range("A1").Select ActiveSheet.Paste Worksheets("SL").Activate Range("A1").Select ActiveSheet.Paste Worksheets("WL-Output").Select endupWL = Range("A65536").End(xlUp).Row For i = 2 to endupWL If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "" Then endupBuy = Worksheets("Buy").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("Buy").Select Range("A" & endupBuy + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Sell" and Range("H" & i).Value = "PT" Then endupPT = Worksheets("PT").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("PT").Select Range("A" & endupPT + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "SL" Then endupSL = Worksheets("SL").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("SL").Select Range("A" & endupSL +1 ).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If Next i Application.ScreenUpdating = True End Sub

Sub kopieren() Application.ScreenUpdating = False Worksheets("Buy").Range("A:Z").Value = "" 'Ich gehe hier davon aus, das max. bis Spalte 'Z belegt ist Worksheets("PT").Range("A:Z").Value = "" Worksheets("SL").Range("A:Z").Value = "" Worksheets("WL-Output").Range("A1:H1").Copy Worksheets("Buy").Activate Range("A1").Select ActiveSheet.Paste Worksheets("PT").Activate Range("A1").Select ActiveSheet.Paste Worksheets("SL").Activate Range("A1").Select ActiveSheet.Paste Worksheets("WL-Output").Select endupWL = Range("A65536").End(xlUp).Row For i = 2 to endupWL If Range("D" & i).Value = "Buy" and Range("H" & i).Value = "" Then endupBuy = Worksheets("Buy").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("Buy").Select Range("A" & endupBuy + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Sell" and Range("H" & i).Value = "PT" Then endupPT = Worksheets("PT").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("PT").Select Range("A" & endupPT + 1).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If If Range("D" & i).Value = "Sell" and Range("H" & i).Value = "SL" Then endupSL = Worksheets("SL").Range("A65536").End(xlUp).Row Range("A" & i & ":H" & i).Copy Worksheets("SL").Select Range("A" & endupSL +1 ).Select ActiveSheet.Paste Worksheets("WL-Output").Select End If Next i Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Zellen in andere Tabellenblätter kopieren

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen in andere Tabellenblätter kopieren

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

303 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