Zeile-Spalte kopieren Code anpassen
Ralf
noch ist meine Frage von vorhin nicht beantwortet und ich stehe schon vor dem nächsten (und bei diesem Projekt hoffentlich letzten) Problem.
Ich habe einen hier gefundenen Code ein wenig verändert und soweit läuft alles.
Werte aus 2 Zeilen kopieren, sortieren und in Zeilen einfügen..... Soweit das Makro, das auch funktioniert.
Ich brauche aber die Spalte A (Die in Zeile 1 kopiert wird) unsortiert. Die andere soll sortiert werden.
Ich habe schon alles versucht... leider ohne Erfolg.
Kann mir jemand auf den richtigen Weg führen?
hier der Code:
Sub FilialenVonZeileInSpalte()
Dim objSortedList As Object
Dim objArrayList As Object
Dim lngLetzte As Long
Dim intSpalte As Integer
Dim lngIndex As Long
Dim vntArray As Variant
ThisWorkbook.Worksheets("Ergebnis").Activate ' den Tabellenblattnamen ggf. anpassen!
Range("D2:AZ3").ClearContents ' den Ausgabe-Bereich löschen
For intSpalte = 1 To 2 ' Spalte A und B
lngLetzte = Cells(Rows.Count, intSpalte).End(xlUp).Row
vntArray = Range(Cells(2, intSpalte), Cells(lngLetzte, intSpalte)).Value2
Set objSortedList = CreateObject(Class:="System.Collections.SortedList")
Set objArrayList = CreateObject("System.Collections.ArrayList")
objSortedList.capacity = UBound(vntArray)
For lngIndex = 1 To UBound(vntArray)
If Not IsEmpty(vntArray(lngIndex, 1)) Then _
objSortedList(vntArray(lngIndex, 1)) = ""
Next lngIndex
objArrayList.AddRange objSortedList.keys
lngLetzte = objSortedList.keys.Count - 1 ' die letzte Ausgabe-Spalte ermitteln
If intSpalte = 1 Then ' wenn Spalte A, dann Zeile 1
Range(Cells(1, 4), Cells(1, 4 + lngLetzte)) = objArrayList.toarray
Else ' wenn Spalte B, dann Zeile 2
Range(Cells(2, 4), Cells(2, 4 + lngLetzte)) = objArrayList.toarray
End If
Set objArrayList = Nothing ' die Ressourcen zurücksetzen
Set objSortedList = Nothing
Next intSpalte
End Sub
Vielen Dank schonmal
LG Ralf