Ersatzteile in einer Exceltabelle verwalten

Hallo Forum,
ich habe ein excel-Problem, dass ich allein nicht lösen kann.
Die Sache ist etwas komplex (für mich). Ich arbeite als Monteur und möchte meine Ersatzteile in einer Exceltabelle verwalten. Ich habe mir schon eine Tabelle wie folgt erarbeitet:
-ein Tabellenblatt Artikelstamm der Ersatzteile ist integriert, jedes Ersatzteil hat eine Nr. und eine Bezeichnung
-ein Tabellenblatt mit einfacher Inventur (wird von Hand gemacht) ist integriert, nur bei mir vorhandene Ersatzteile werden per SVERWEIS aus dem Artikelstamm hier eingefügt
Nun möchte ich noch folgende Sachen realisieren, die sicher nur mit einem Makro funktionieren:
-im Tabellenblatt Inventur möchte ich die Ersatzteile einer Gruppe zuordnen, nach dem Muster 1 = Befestigungsmaterial, 2 = Elektro, etc., etwa so:
Gruppe Ersatzteil-Nr. Mat.-Bezeichnung
1 11111 Schraube
2 22222 Steckdose
und diese Gruppen dann auslesen und in ein Tabellenblatt Befestigungsmaterial, Elektro, etc. kopieren. Das sollte auch funktionieren, wenn im betreffenden Tabellenblatt schon Ersatzteile drin stehen, es sollen also nur die neuen hinzugefügt oder alle ersetzt werden und dann alle nach Ersatzteilnummer aufsteigend sortiert werden.
Gruss Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Christian,
das sollte es tun:

Option Explicit
Sub Verteile()
Dim strG As Variant, lngL As Long, zz As Long, intK As Integer, lngV As Long
Const intSp As Integer = 1  ' Spalte A
'             Null ist das Blatt, wenn in Spalte A nichts oder 0 steht
strG = Split("Null Befestigungsmaterial Elektro etc" & _
" etc etc etc etc etc" & _
" etc etc etc etc")
ActiveSheet.Copy after:=Sheets(Sheets.Count)
lngL = Cells(Rows.Count, intSp).End(xlUp).Row
ActiveSheet.Range(Rows(1), Rows(lngL)).Sort _
Key1:=Cells(1, intSp), Order1:=xlAscending, _
Key2:=Cells(1, intSp + 1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1
lngL = Cells(Rows.Count, intSp).End(xlUp).Row
intK = Cells(2, intSp)
lngV = 2
For zz = 3 To lngL + 1
If intK <> Cells(zz, intSp) Then
With Sheets(strG(intK))
.Cells.ClearContents
Rows(1).Copy Destination:=.Cells(1, 1)
Range(Rows(lngV), Rows(zz - 1)).Copy Destination:=.Cells(1, 1)
intK = Cells(zz, intSp)
lngV = zz
End With
End If
Next zz
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

Bei der Belegung von StrG kommt es besonders auf die Leerzeichen an (zwischen zwei Blattnamen jeweils ein Leerzeichen).
Die hier genannten Blätter müssen angelegt sein.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Ersatzteile in einer Exceltabelle verwalten

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread