Thema Datum  Von Nutzer Rating
Antwort
Rot Sortieren
16.10.2020 06:54:09 Matthias
NotSolved
16.10.2020 16:54:22 Gast45467
NotSolved

Ansicht des Beitrags:
Von:
Matthias
Datum:
16.10.2020 06:54:09
Views:
44
Rating: Antwort:
  Ja
Thema:
Sortieren

Guten Morgen, 

ich habe folgenden Code, der auch funktioniert

nun möchte ich die übertragenen Zeilen (ab Zeile 13)

nach den Inhalten der Spalte A Sortieren.

Ist das möglich?

Schöne Grüsse

Matthias

 

Sub Uebertrag_AlleMontagefirmaAAA()
Dim loAnz As Long, loLetzte As Long
Dim raBereich As Range, raZelle As Range
Dim lngCalc As Long
Application.ScreenUpdating = False
lngCalc = Application.Calculation
Application.Calculation = xlCalculationManual
With Worksheets("MontagefirmenAlle")
    .Range("A1:xfd" & .Cells(.Rows.Count, 1).End(xlUp).Row).Clear
End With
With Worksheets("Terminplan")
    .Columns("A:B").Hidden = False
    Set raBereich = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    
    
    For Each raZelle In raBereich.SpecialCells(xlCellTypeVisible)
    
            If Not Worksheets("Montage Firmen").Range("B2:B12").Find( _
                What:=raZelle.Text, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByColumns, _
                MatchCase:=False, _
                MatchByte:=False _
            ) Is Nothing Then
        
            
            raZelle.EntireRow.SpecialCells(xlCellTypeVisible).Copy
            loAnz = loAnz + 1
            With Worksheets("MontagefirmenAlle")
                loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
                If .Cells(1, "A") = "" Then loLetzte = 1
                .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteFormats
            End With
        End If
        Application.CutCopyMode = False
    Next raZelle
    .Columns("A:B").Hidden = True
End With
Application.Calculation = lngCalc
MsgBox "Es wurden " & loAnz & " Sätze übertragen."
Set raBereich = Nothing
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Sortieren
16.10.2020 06:54:09 Matthias
NotSolved
16.10.2020 16:54:22 Gast45467
NotSolved