Guten Tag zusammen,
ich hab hier ein Problem, dass mich wahnsinnig macht. Meine VBA Kenntnisse sind nicht gerade die besten, würde sogar sagen ich bin Anfänger. Zu meinem Problem:
Ich habe eine Liste mit zwei Registerkarten "Aktueller Bestand" und "Archiv"
Ich möchte, dass wenn die Spalte 18 mit "Ja" deklariert wird oder die Spalte 25 mit "Ja" deklariert wird, dass die ganze Zeile ausgeschnitten und in die nächste freie Zeile (Zeile 7) eingefügt wird. Dabei ist es wichtig, dass die Formeln nicht mitgenommen werden, d.h. ich möchte nur die Werte haben, die ich aus "Aktueller Bestand" kopiere. So nun möchte ich, dass die leere Zeile, die sich ja jetzt in der Registerkarte "Aktueller Bestand" gebildet hat, gelöscht wird.
Hier der bisherige Code mit all den Erklärungen, die ich mir zusammengereimt habe. Hoffe mir wann jemand weiterhelfen, bin am verzweifeln :( VIELEN DANK FÜR JEDE HILFE
Sub Archivieren()
' Die umgerüsteten oder an Sperrlager Rot gelieferten Motoren werden aus "Aktueller Bestand" an "Archiv" übersendet.
' Die Formeln werden dabei NICHT übertragen, sondern nur die Werte
Dim Zeile As Long
Dim Anzahl1 As Long
Dim Anzahl2 As Long
Dim sZeile As String
' Deklaration der einzelnen Variablen
Sheets("Aktueller Bestand").Activate ' Auswahl der Registerkarte "Aktueller Bestand"
Anzahl1 = ActiveSheet.UsedRange.Rows.Count ' Excel zählt in der Registerkarte "Aktueller Bestand" alle Zeilen, die in der Spalte FZ etwas drinstehen haben ab Anfang
i=1
For Zeile = 1 To Anzahl1
Sheets("Aktueller Bestand").Activate ' Für die Zeilen 1 bis zur letzten Zeile in der Registerkarte "Aktueller Bestand"_
If Cells(Zeile, 18).Value = "Ja" Or Cells(Zeile, 25).Value = "Ja" Then ' Wenn die Spalte "Zur Umrüstung?" ODER "Zum Sperrlager Rot?" mit Ja gekennzeichnet sind
sZeile = LTrim(Str(Zeile))
Rows(sZeile & ":" & sZeile).Select
Selection.Copy ' Die ausgewählten Zeilen werden nun kopiert und in den Zwischenspeicher gespeichert
Sheets("Archiv").Select ' Die Registerkarte "Archiv" wird ausgewählt
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False ' Nur die Werte und nicht die Formeln werden übertragen
Sheets("Aktueller Bestand").Select ' Nun wird die Registerkarte ("Aktueller Bestand") gewählt.
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 ' Nun werden sämtliche Zeilen begutachtet
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete ' Wenn nun eine Zeile keinen Wert hat, dann soll sie gelöscht werden
Next
End If
End Sub
|