Fortlaufende Nummer VBA

Hallo zusammen,
ich habe ein Problem mit einer Aufgabe und hoffe ihr könnt mir dabei weiterhelfen, da ich nicht sehr fit mit VBA bin.
Ich habe eine Excel-Datei, in der händisch Informationen bzgl. eines bestimmten Angebotes eingegeben werden können, wie z.B. Jahr, Name. Kunde etc.
Zudem gibt es eine Datei, in der alle Angebote gesammelt werden und anhand einer Angebotsnummer angegeben werden.
Ich möchte nun, dass ich in der ersten Datei alle Informationen angebe und dann auf einen Button klicke, der mir dann die nächste fortlaufende Nummer (anhand der zweiten Datei) ausspuckt und in erstere Datei einfügt. Zudem soll dann das Angebot in der zweiten Datei abgespeichert werden.
Zusammengefasst: 2 Dateien; erstelle fortlaufende Nummer für erste Datei anhand vorhandener Angebote in zweiter Datei; gebe diese Nummer in die erste Datei aus; speichere die Nummer (und einige Infos) aus der ersten in die zweite Datei
Wäre super, wenn ihr mir weiterhelfen könntet :)
Beste Grüße,
C.Stoiber

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Da war ich ja schon nahe dran.
An deine Tabellen angepasst
(xls habe ich in xlsx geändert, weil es sonst bei mir Probleme gab)


Private Sub ProjektNr_Click()
Dim TB1 As Worksheet, WB2 As Workbook, TB2 As Worksheet
Dim LR As Double, ZSP As Integer
Dim Arr, Sp As Integer, NR As Double
Dim Pfad As String, Datei As String
Pfad = "C:\Temp\"
Datei = "Mappe2.xlsx"
Set TB1 = ActiveWorkbook.Sheets("Projektinformationen") ' Eingabetabelle
Set WB2 = Workbooks.Open(Pfad & Datei) ' Sammeldatei
Set TB2 = WB2.Sheets("Angebotscheckliste ") 'Tabellenblatt in Sammeldatei
Sp = 3 'Spalte für Angebotsnummer: Hier C
With TB2
LR = .Cells(Rows.Count, Sp).End(xlUp).Row + 1 'erste freie Zeile der Spalte A
'Neue NR setzen
NR = .Cells(LR - 1, Sp) + 1
TB1.Range("D3") = NR
'Eingabewerte einsetzen
.Cells(LR, 3) = NR
.Cells(LR, 4) = TB1.Range("I3")
.Cells(LR, 5) = TB1.Range("H3")
End With
WB2.Close True 'inkl. speichern
End Sub

Gruß UweD

Sub Angebot() Dim TB1 As Worksheet, WB2 As Workbook, TB2 As Worksheet Dim LR As Double Dim Arr, SP As Integer, NR As Integer Dim Pfad As String, Datei As String Pfad = "C:\Temp\" Datei = "Mappe2.xlsx" Set TB1 = ActiveWorkbook.Sheets("Tabelle1") ' Eingabetabelle Set WB2 = Workbooks.Open(Pfad & Datei) ' Sammeldatei Set TB2 = WB2.Sheets("Tabelle1") 'Tabellenblatt in Sammeldatei SP = 1 'Spalte für Angebotsnummer: Hier A With TB2 LR = .Cells(Rows.Count, SP).End(xlUp).Row + 1 'erste freie Zeile der Spalte A 'Neue NR setzen NR = .Cells(LR - 1, SP) + 1 TB1.Range("A2") = NR 'Eingabewerte einsetzen TB1.Range("A2:J2").Copy .Cells(LR, SP) End With WB2.Close True 'inkl. speichern End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread