VBA Code Umstellung / Anpassung
07.04.2016 05:59:39
Matthias
ich benötige eure Hilfe bei der Anpassung / Umstellung eines Codes.
Ich habe einen funktionierenden Code mit dem der
Inhalt einer Spalte alphabetisch sortiert wird und anschließend eine
gewisse Anzahl von Leerzeilen eingefügt wird. Die Anzahl der Leerzeilen
wird per InputBox abgefragt.
Ich möchte den Code nun so zu erweitern, dass damit auch gleichzeitig
in einer anderen Tabelle der selben Datei der Inhalt von Spalten sortiert wird
und die gleiche in die InputBox eingegebene Anzahl an Leerspalten eingefügt wird.
Der Ablauf soll so aussehen:
Nach Eingabe einer Zahl in die InputBox sollen als Erstes in der Tabelle
Baugruppen alle Spalten ab Spalte E alphabetisch sortiert werden. Das
Sortieren soll sich auf die Inhalte in Zeile 6 ab Spalte E beziehen.
Es muss aber der gesamte Inhalt der Spalten mit werschoben werden!
Anschließend soll die in die Inputbox eingegebene Zahl als Leerspalten
dazwischen eingefügt werden. Danach soll der bisherige Code weiterlaufen,
aber ohne eine erneute Eingabe in die Inputbox.
Der Code wird aus einer anderen Tabelle gestartet.
Falls es wichtig ist hier noch der Hinweis, dass die Inhalte in der
Tabelle Baugruppen in Zeile 6 per Formel (=INDEX(Material!$E:$E;SPALTE
(J9)) usw. ) dargestellt werden. In meinen bisherigen Fehlversuchen war das
aber nicht ausschlaggebend.
Wichtig ist evtl noch, dass die Zellen A1 bis L1 sowie A2 bis C6 in der
Tabelle Baugruppen verbundene Zellen sind.
Hier der bisherige Code:
Sub Einzel_Sortieren_Material()
' Einzel_Sortieren
' sortiert das ganze Blatt alphabetisch nach Inhalt von E10
' und fügt Leerzeilen nach Eingabeaufforderung ein
Application.ScreenUpdating = False
If ActiveSheet.ProtectContents = True Then
MsgBox "Bitte Bearbeitungsmodus aktivieren!."
End
Exit Sub
Else
End If
Dim i As Long
Dim tbl As Worksheet
Dim vAnzahl As Variant
Do
vAnzahl = Application.InputBox("Wie viele Leerzeilen sollen
eingefügt werden? Bitte eine Ziffer zwischen 1 und 10 eingeben!", " Die
Anzahl der Leerzeilen angeben.", Type:=1)
If vAnzahl = False Then Exit Sub
Loop While vAnzahl 10
Range("A10", Range("E65536").End(xlUp).Offset(0, 5)).Select
Selection.Sort Key1:=Range("E10"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
Set tbl = Sheets("Material")
For i = 1000 To 11 Step -1
If tbl.Range("E" & i) tbl.Range("E" & i - 1) Then
tbl.Range(tbl.Range("E" & i), tbl.Range("E" & i + vAnzahl -
1)).EntireRow.Insert Shift:=xlDown
End If
Next i
Application.ScreenUpdating = True
End Sub
Ich hoffe ihr könnt mir helfen
Gruß
manega