Markieren von Zeilen mit gleichem Wert in Spalte B

Hallo an alle xls-Götter und VBA-Profis,
ich hoffe, Ihr könnt mir helfen...
ich bekomme eine Tabelle, aus der ich pro Kd.nummer (jeweils Spalte B)Bestätigungen erstellen muss.
Jedes Geschäft hat eine Zeile, es können aber auch mehrere Geschäfte zu einer Kd.nummer gehören,
bsp. 6 Zeilen haben in Spalte B die gleiche Kd.nummer... somit hat dieser Kunde 6 Geschäfte gemacht
ich hab (mit meinen bescheidenen VBA-Kenntnissen) versucht, eine For Next - Schleife zu erstellen, in der geprüft wird, ob die Ktonummer noch gleich der vorherigen...pro Kdnummer sollen dann die jeweiligen Zeilen markiert, in ein neues xls-Formular kopiert und dieses Formular unter dieser Kd.nummer abgespeichert werden and so on...bis die Tabelle abgearbeitet ist.
hier mein kläglicher Versuch:
Problem 1 ich kriegs nicht hin, die entsprechenden Zeilen zu kopieren
Problem 2 das abspeichern unter der jeweiligen Kd.nummer klappt noch nicht
Danke vorab schonmal für Eure Hilfe!
Gussfuss
Dim intktonummer As Integer
Dim intZeilenanzahl As Integer
Dim intkdnummer As Integer
Dim intzeile As Integer
Dim intZeilenanzahllast As Integer
Dim strdateinameneu As String
Dim strdateiname As String
intZeilenanzahllast = Cells(Rows.Count, 2).End(xlUp).Row
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Workbooks.Open ThisWorkbook.Path & "\muster.xls"
Windows("Testdatei.xls").Activate
For intzeile = 2 To intZeilenanzahllast
Beginn:
If Cells(intzeile, 2).Value = Cells(intzeile + 1, 2).Value Then
Range(ActiveCell, Cells(intzeile, 1)).Select
'hier möchte ich in einer Schleife alle Zeilen markieren, die gleiche Ktonummer (Spalte B)aufweisen
intzeile = intzeile + 1
GoTo Beginn
Else: Selection.Copy
Windows("muster.xls").Activate
Range("D4").Select
ActiveSheet.Paste
intkdnummer = Cells(intzeile, 2).Value
With ActiveDocument
.SaveAs ActiveDocument.Path & "\" & intkdnummer 'hier scheitere ich beim Speichern...
.Close
End With
Windows("Testdatei.xls").Activate
End If
Next intzeile
Windows("Testdatei.xls").Activate
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Bestätigungen wurden abgespeichert!"
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gussfuss,
hier dein Code angepasst. Auf die Select und Activate-Anweisungen wurde dabei verzichtet und die Zellbereiche direkt berechnet und kopiert. Für den zu kopierenden Bereich muss du ggf. noch die Nummern der Spalten anpassen. Wegen besserer Übersichtlichkeit sind die Arbitsmappen und Tabellenblätter, die an den Aktionen berteiligt sind als Objekte deklariert.
Gruß
Franz


Sub aaTest()
'  Dim intktonummer As Integer
'  Dim intZeilenanzahl As Integer
'  Dim intkdnummer As Integer
Dim intzeile As Integer
Dim intZeile1 As Integer
Dim intZeileL As Integer
Dim intZeilenanzahllast As Integer
'  Dim strdateinameneu As String
Dim vardateiname As Variant
Dim wksAlle As Worksheet
Dim wbAlle As Workbook
Dim wksKdnNummer As Worksheet
Dim wbKdnNummer As Workbook
Set wbAlle = ActiveWorkbook 'Datei mit allen Bestätigungen
Set wksAlle = ActiveSheet 'Tabellenblatt mit allen Bestätigungen
'letzte Zeile in Tabellenblatt mit allen Bestätigungen ermitteln
With wksAlle
intZeilenanzahllast = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With wksAlle
For intzeile = 2 To intZeilenanzahllast
'Musterdatei schreibgeschützt öffnen
Set wbKdnNummer = Workbooks.Open(FileName:=ThisWorkbook.Path & "\muster.xls", _
ReadOnly:=True)
Set wksKdnNummer = wbKdnNummer.Worksheets(1) 'Zieltabele für das Kopieren
intZeile1 = intzeile '1. Zeile der Kundennummer
'Kundennummer als Dateiname merken
vardateiname = .Cells(intzeile, 2).Value & ".xls"
'Zeilenummern erhöhen bis Kundennummern unterschiedlich
Do While .Cells(intzeile, 2).Value = .Cells(intZeile1, 2).Value _
And Not intzeile > intZeilenanzahllast
intZeileL = intzeile ' LetzteZeile der Kundennummer
intzeile = intzeile + 1
Loop
'Zeilen-Zähler wieder um 1 zurücksetzen
intzeile = intzeile - 1
'Zellbereich mit Kundennummer kopieren ##Spaltenummern anpassen!!!
.Range(.Cells(intZeile1, 1), .Cells(intZeileL, 6)).Copy _
Destination:=wksKdnNummer.Range("D4")
'Musterdatei unter KundenNr.xls speichern
wbKdnNummer.SaveAs FileName:=ActiveWorkbook.Path & "\" & vardateiname
wbKdnNummer.Close
Next intzeile
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
WbAlle.Activate
MsgBox "Bestätigungen wurden abgespeichert!"
End Sub

Beliebteste Forumthreads (12 Monate)

Markieren von Zeilen mit gleichem Wert in Spalte B

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Markieren von Zeilen mit gleichem Wert in Spalte B

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread