Leerzeichen Spalte automatisch entfernen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range If Not Intersect(Target, Columns(3)) Is Nothing Then For Each C In Intersect(Target, Columns(3)) Application.EnableEvents = False C.Replace " ", "" Application.EnableEvents = True Next End If End Sub

Public Sub Zeile_verschieben_2(s1 As Worksheet, c1 As Range) Dim s2 As Worksheet If ((c1.Cells.Count = 1) And (c1.Column = 21)) Then Select Case c1.Value Case "": Set s2 = Nothing Case "Bezahlt": Set s2 = Worksheets("Bezahlte_Bestellungen") ' ... Case Else Set s2 = Nothing MsgBox "Gibt ein Zahlungsfehler" End Select If (Not s2 Is Nothing) Then s1.Rows(c1.Row).Cut Destination:=s2.Rows(s2.Cells(65536, 1).End(xlUp).Row + 1) End If End If End Sub

Public Sub Zeilen_exportieren() Dim Zelle As Range, Kopie As Range, Ziel As Range For Each Zelle In ActiveSheet.Range("U2:U" & Cells(Rows.Count, "U").End(xlUp).Row) If UCase$(Zelle) = "BEZAHLT" Then If Kopie Is Nothing Then Set Kopie = Zelle.EntireRow Else Set Kopie = Union(Kopie, Zelle.EntireRow) End If Next If Not Kopie Is Nothing Then With Worksheets("Bezahlte_Bestellungen") Set Ziel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) End With Kopie.Copy Destination:=Ziel 'Kopie.Delete '=alte Zeile(n) löschen Kopie.ClearContents ' =Zelleninhalte in den alten Zeile(n) entfernen Set Kopie = Nothing: Set Ziel = Nothing End If

Ja, da waren noch Teufelchen drin.
Und dieses Makro musst du der Schaltfäche1 zuweisen.

Public Sub Zeilen_exportieren()

   
    Dim Zelle As Range, Kopie As Range, Ziel As Range
    
    
    For Each Zelle In ActiveSheet.Range("U2:U" & ActiveSheet.Cells(Rows.Count, "U").End(xlUp).Row).Cells
        
        If UCase$(Zelle) = "BEZAHLT" Then
            If Kopie Is Nothing Then
                Set Kopie = Zelle.EntireRow
            Else
                Set Kopie = Union(Kopie, Zelle.EntireRow)
            End If
        End If
        
    Next
    
    If Not Kopie Is Nothing Then
    
        With Worksheets("Bezahlte_Bestellungen")
            Set Ziel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        End With
        
        Kopie.Copy Destination:=Ziel
                
        'Kopie.Delete '=alte Zeile(n) löschen
        Kopie.Clear ' =Zelleninhalte der alten Zeile(n) entfernen
        
        Set Kopie = Nothing: Set Ziel = Nothing
    
    End If
    
    
End Sub

Gruß Gerd

Beliebteste Forumthreads (12 Monate)

Leerzeichen Spalte automatisch entfernen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread