PDA

Vollständige Version anzeigen : HILFE - Wenn Wert in Spalte, dann Zeile in neues Tabellenblatt


berlinmal
18.07.2014, 12:43
Hallo,

ich möchte gern eine komplette Zeile aus dem Tabellenblatt "2014" kopieren, und in ein weiteres Tabellenblatt "Gemeinschaftsgeschäft 2014" einfügen, wenn im Tabellenblatt "2014" in Spalte D ab Zeile 11 eine Zahl größer als 0 vorhanden ist.

Die Werte beim sollen erst ab Zeile 11 im Tabellenblatt "Gemeinschaftsgeschäft 2014" eingefügt werden und dann fortlaufend.

Ist in der, ich nenne sie mal Basistabelle "2014" kein Wert in Spalte D ausgewiesen, dann soll auch nichts kopiert werden, sondern in den darauffolgenden Zeilen weitergeschaut werden.

Ich hoffe ihr könnt mir hier weiterhelfen, das wäre sehr nett...

Liebe Grüße und danke schonmal.

Anbei mein Versuch, der aber leider NICHT klappt !!!



Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 7 Then Exit Sub ' begrenzt die Reaktion auf Aktionen nur in Spalte 7 = Spalte G
If Target.Row < 11 Then Exit Sub ' begrenzt die Reaktion auf Aktionen nur ab Zeile 11

Application.ScreenUpdating = False

Dim myLastRow As Long ' für die letzte Zeile in Gemeinschaftsgeschäft 2014

With Sheets("Gemeinschaftsgeschäft 2014")
myLastRow = .Cells(Rows.Count, 1).End(xlUp).Row ' sucht die letzte gefüllte Zelle in Spalte A
If myLastRow < 7 Then myLastRow = 7 ' damit beginnt das Füllen erst ab Zeile 8
End With

If Sheets("2014").Cells(Target.Row, 7).Value <> "" Then ' hier muss der gewünschte Name rein

' Zeile kopieren
Sheets("2014").Rows(Target.Row).Copy Destination:=Sheets("Gemeinschaftsgeschäft 2014").Rows(myLastRow + 1)

End If

Application.ScreenUpdating = True

End Sub

Mc Santa
18.07.2014, 12:53
Hallo,

Wann genau soll das Makro ausgeführt werden? Über einen Button?
Und was genau funktioniert nicht? Wird zu viel kopiert? Wird etwas nicht kopiert? Wird etwas überschrieben?

VG

R J
18.07.2014, 12:57
Hi End Sub,

versuch es so:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 7 Then Exit Sub ' begrenzt die Reaktion auf Aktionen nur in Spalte 7 = Spalte G
If Target.Row < 11 Then Exit Sub ' begrenzt die Reaktion auf Aktionen nur ab Zeile 11

Application.ScreenUpdating = False

Dim myLastRow As Long ' für die letzte Zeile in Gemeinschaftsgeschäft 2014

With Worksheets("Gemeinschaftsgeschäft 2014")
myLastRow = .Cells(Rows.Count, 1).End(xlUp).Row ' sucht die letzte gefüllte Zelle in Spalte A
If myLastRow < 7 Then myLastRow = 7 ' damit beginnt das Füllen erst ab Zeile 8
.Cells(myLastRow, 1) = Target
End With

Application.ScreenUpdating = True

End Sub

berlinmal
18.07.2014, 13:14
Mc Santa bei Eingabe soll macro laufen !!

Mc Santa
18.07.2014, 13:21
Mc Santa bei Eingabe soll macro laufen !!

Dann wäre nur noch die Rückfrage zu beantworten, was nicht so funktioniert, wie du es erwartest.

Viele Grüße

R J
18.07.2014, 13:30
...Korrektur:

die zeile vor dem End with muss so lauten:

If Target <> "" Then .Cells(myLastRow + 1, 1) = Target

berlinmal
18.07.2014, 13:34
würde über ein button gehen oder bei eingabe der wert in der zeile
Es wird kopiert aber nicht die ganze Zeile ! und wird nicht fortlaufende kopiert
Danke

Mc Santa
18.07.2014, 13:40
Hallo,

mal ins Blaue geraten, leider gibst du keine sehr brauchbaren Informationen :(
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 Then
If Target.Row >= 11 Then

Application.ScreenUpdating = False

Dim myLastRow As Long

With Worksheets("Gemeinschaftsgeschäft 2014")
myLastRow = .Cells(Rows.Count, 7).End(xlUp).Row
If myLastRow < 7 Then myLastRow = 7
.Cells(myLastRow + 1, 1).EntireRow.Value = Target.EntireRow.Value
End With

Application.ScreenUpdating = True
End If
End If

End Sub

Hoffe es funktioniert wie gewünscht..
VG

berlinmal
18.07.2014, 13:56
Danke ich Teste Es !

berlinmal
18.07.2014, 14:24
das klappt geht es auch ein neue tab zu öffenen und beschrieben wird !

berlinmal
18.07.2014, 15:05
Eine kurze Antwort wäre genial ! :)

Mc Santa
18.07.2014, 15:13
Hallo,

ich, habe leider wieder viel zu wenig Informationen.
Was meinst du mit "ein neue tab" ?

Ein neues (leeres) Tabellenblatt in der selben Exceldatei?
Eine neue (leere) Datei?
Ein neues (leeres) Tabellenblatt in einer bestehenden Exceldatei?
Ein bereits bestehendes Tabellenblatt in einer bestehenden Exceldatei?
Sonstiges?

Gibt es sonst etwas zu beachten?

Bitte antworte auf alle gestellten Rückfragen, nicht nur auf einen Teil davon.

Viele Grüße

berlinmal
18.07.2014, 15:24
1 würde gehen
Danke

Mc Santa
18.07.2014, 15:29
Hallo,

dann teste einmal diesen Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 Then
If Target.Row >= 11 Then

Application.ScreenUpdating = False

Dim myLastRow As Long
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet
myLastRow = .Cells(Rows.Count, 7).End(xlUp).Row
If myLastRow < 7 Then myLastRow = 7
.Cells(myLastRow + 1, 1).EntireRow.Value = Target.EntireRow.Value
End With

Application.Goto Target
Application.ScreenUpdating = True
End If
End If

End Sub

berlinmal
18.07.2014, 15:36
Ok mache ich !

berlinmal
18.07.2014, 15:39
Sieht gut aus erstmal Danke :)

berlinmal
18.07.2014, 15:43
ich auch möglich A6 bis G6
ein fach einz zu ein zu kopiren inden neuen Leere Tabellen
ALs Kopfzeile

berlinmal
18.07.2014, 15:45
A1-A6
B1-B6
C1 C6
E1-E6
F1-F6
G1-G6
alles Felder

Mc Santa
18.07.2014, 15:52
Es wäre wirklich hilfreich, wenn du die Aufgabe von Anfang an vollständig beschreibst.
Ich habe keine Lust, den Code so oft zu ändern.

VG

berlinmal
18.07.2014, 19:33
Funktioniert jetzt fast.

Jede Zeile (mit dem betreffenden Inhalt in der Spalte) wird jetzt kopiert.

Allerdings jede Zeile in ein neues Blatt.

Stattdessen sollten die Zeilen in den bestehenden Blatt (gleiches File) "Gemeinschaftsgeschäft 2014" untereinander stehen !

Sorry, dass ich mich anfangs vielleicht zu ungenau ausgedrückt habe... Super wäre ein finaler Vorschlag... Sitze schon 4 Std an dieser Aufgabe :-/

Mc Santa
18.07.2014, 19:48
Hallo,

hier noch ein Versuch:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 Then
If Target.Row >= 11 Then

Application.ScreenUpdating = False

Dim myLastRow As Long

If Not wsExists("Gemeinschaftsgeschäft 2014") Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Gemeinschaftsgeschäft 2014"
Target.Parent.Cells(1, 1).Resize(6).EntireRow.Copy Worksheets("Gemeinschaftsgeschäft 2014").Cells(1, 1)
End If
With Worksheets("Gemeinschaftsgeschäft 2014")
myLastRow = .Cells(Rows.Count, 7).End(xlUp).Row
If myLastRow < 7 Then myLastRow = 7
.Cells(myLastRow + 1, 1).EntireRow.Value = Target.EntireRow.Value
End With

Application.ScreenUpdating = True
End If
End If

End Sub

Private Function wsExists(wsName As String) As Boolean
On Error Resume Next
wsExists = ThisWorkbook.Worksheets(wsName).Index > 0
End Function

Freue mich über Feedback.

Viele Grüße

berlinmal
21.07.2014, 07:56
noch einmal brauche ich dein hilfe!
Danke es klappt
Allerdings jede Zeile in neues Blatt!
Stattdessen sollten die zeilen in den bestehenden Blatt (gleiche File)
"Gemeinschaftsgeschäft 2014 " untereinander stehen !!!!
DANKE

Mc Santa
21.07.2014, 13:07
noch einmal brauche ich dein hilfe!
Danke es klappt
Allerdings jede Zeile in neues Blatt!
Stattdessen sollten die zeilen in den bestehenden Blatt (gleiche File)
"Gemeinschaftsgeschäft 2014 " untereinander stehen !!!!
DANKE

Hallo,

mein letzter Code macht das nicht? Dann lade bitte eine neue Beispieldatei hoch, in der es nicht geht.

VG