Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Hoax vom 07.09.2022, 19:20 Options

Zeile in neues Blatt kopieren, wenn Bedingung erfüllt

Hallo Forum,

ich habe für Excel eine Tabelle/Blatt, welche ich nachhaltig pflegen möchte.
In dem Blatt "Lagerliste" stehen in jeder Reihe Daten, ab A9 bis R9 und abwärts bis ca. 700.
Wenn ich nun in M9 o M... ein Datum eintrage, möchte ich, daß die jeweilige Zeile (in diesem Fall 9) in eine neues Blatt names "Legende" jeweils in die nächste freie Zeile kopiert wird.
Ich habe gelesen mit VBA wäre sowas möglich...

Grüße

Hajo

Antwort schreiben

Antwort 1 von Hajo_Zi vom 07.09.2022, 19:43 OptionsLösung

Hallo Hajo,


Option Explicit

Private Sub Worksheet_change(ByVal Target As Range)
    If Target.Column = 13 And IsDate(Target) And Target <> "" Then
        With Worksheets("Legende")
            Dim LoLetzte As Long
            LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 13)), _
                .Cells(.Rows.Count, 13).End(xlUp).Row, .Rows.Count) + 1
            Rows(Target.Row).Copy .Cells(LoLetzte, 1)
        End With
    End If
End Sub

Gruß Hajo

Antwort 2 von rainberg vom 07.09.2022, 19:57 Options

Hallo Hajo,

anbei ein Beispiel

Gruss
Rainer

Antwort 3 von Hoax vom 07.09.2022, 21:47 Options

Vielen Dank ihr beiden,

nicht nur für das funktionierende Makro, auch für die wirklich schnelle Antwort. immerhin hab ich heute schon etwa 9 Stunden an der Lösung gebastelt, aber außer Laufzeitfehler xy ist nichts bei rumgesprungen.

Kann man nachdem die betreffende Zeile kopiert wurde, den Inhalt der Zellen J,K,M und N aus dem Blatt "Lagerliste" automatisch löschen, so das man es nicht mehr manuell machen muß?

Grüße

Hajo

Antwort 4 von Hajo_Zi vom 08.09.2022, 09:28 Options

Hallo Hajo,

ungetestet


Option Explicit

Private Sub Worksheet_change(ByVal Target As Range)
    If Target.Column = 13 And IsDate(Target) And Target <> "" Then
        With Worksheets("Legende")
            Dim LoLetzte As Long
            LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 13)), _
                .Cells(.Rows.Count, 13).End(xlUp).Row, .Rows.Count) + 1
            Rows(Target.Row).Copy .Cells(LoLetzte, 1)
            Rows(Target.Row)..delete
        End With
    End If
End Sub

Gruß Hajo

Antwort 5 von Hajo_Zi vom 08.09.2022, 09:52 Options

Hallo Hajo,

ein Punkt zu viel
Rows(Target.Row).delete

Gruß Hajo

Antwort 6 von Saarbauer vom 08.09.2022, 11:18 Options

Hallo @ Hajo_Zi

ich glaube @Hoax will nur den Inhalt der Spalten J,K,M und N löschen und nicht die komplette Zeile

Gruß

Helmut

Antwort 7 von Hoax vom 08.09.2022, 17:51 Options

Hallo und vielen Dank,

genau so ist es, lediglich der Inhalt von J,K,N und M soll aus der zuvor kopierten Zeile in Lagerliste gelöscht werden und nicht die komplette Zeile.

Gruß

Hajo

Antwort 8 von Hajo_Zi vom 08.09.2022, 17:59 Options

Hallo Hajo,

cells(Target.Row,10)=""
cells(Target.Row,11)=""
cells(Target.Row,13)=""
cells(Target.Row,14)=""

Gruß Hajo

Antwort 9 von Hoax vom 09.09.2022, 18:48 Options

Danke, funktioniert fabelhaft...

dummerweise enthält das Blatt noch weitere Makros, wenn ich nun das Makro refresh starte:
----------------------------------------------------------------------------------------------
Sub Refresh__neu()
'
' Refresh__neu Makro
'

'
Range("A5:R5").Select
Selection.ClearContents
Range("A6").Select
Application.Run "Werkzeuglager.xls!Suchen"
End Sub
----------------------------------------------------------------------------------------------

erscheint die Fehlermeldung:

Laufzeitfehler "13"
Typen unverträglich

Was bedeutet das?

Grüße
Hajo

Antwort 10 von Saarbauer vom 10.09.2022, 08:42 Options

Hallo,

gehe mal das Makro mit Einzelschritten durch, dann zeigt er dir wo es Probleme gibt.

Ich habe es versucht und hatte Probleme nur in der Zeile

Zitat:
Application.Run "Werkzeuglager.xls!Suchen"

ist aber klar, da es die Datei bei mir nicht gibt.

Gruß

Helmut

Antwort 11 von Hoax vom 16.09.2022, 21:29 Options

Hallo Helmut

und vielen Dank für den Tip, ich konnte mit dessen Hilfe die Stelle finden wo es klemmte und hab es geschafft mit Hilfe eines anderen Beitrages aus diesem Forum den VBA-Code so umzustellen, daß es jetzt funktioniert und zwar so:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 13 And Target.Row >= 8 And Target.Row <= 1000 And IsNumeric(Target) Then
Rows(Target.Row).Copy Worksheets("Legende").Rows(Worksheets("Legende").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
cells(Target.Row,10)=""
cells(Target.Row,11)=""
cells(Target.Row,13)=""
cells(Target.Row,14)=""
End If
End If
End Sub

Keine Ahnung warum, aber jetzt funktioniert es :-)

Grüße und vielen Dank

Hajo

Antwort 12 von Hoax vom 16.09.2022, 21:33 Options

Sorry, so ist es jetzt:

Option Explicit

Private Sub Worksheet_change(ByVal Target As Range)
If Target.Column = 13 And Target.Row >= 8 And Target.Row <= 1000 And IsNumeric(Target) Then
With Worksheets("Legende")
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 13)), _
.Cells(.Rows.Count, 13).End(xlUp).Row, .Rows.Count) + 1
Rows(Target.Row).Copy .Cells(LoLetzte, 1)
cells(Target.Row,10)=""
cells(Target.Row,11)=""
cells(Target.Row,13)=""
cells(Target.Row,14)=""
End With
End If
End Sub

Gruß Hajo

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..