Daten zwischen Workbooks kopieren/filtern

Hallo, ich habe hier eine Frage:

Ich muss aus einer Excel-Datei (eine Art elektronisches Kassenbuch), auf der Subtotalen erstellt wurden, Daten in eine 2.Datei schreiben.
Dabei sollen nur diese (pro kunde) mit der Subtotale-Funktion gebildeten Summen zusammen mit Angabe der Kd. Nr etc. in die 2. datei geschrieben werden. Damit es aber nicht zu langweilig wird, muss ich dabei noch zwischen Salden >0 anderes sheet, =0 gar nicht kopieren)

wie mache ich das möglichst sinnvoll?
Mein bisheriger Code sucht in der 1.Tabelle mit einer for-schleife nach fett gedruckten zellen (von Excel für die Subtotalen vorgegeben) und fragt danach das zugehórige saldo ab. Danach werden die Daten (Kd.Nr etc. aus der Zeile darüber)in die entsprechenden Tabellen kopiert.

Sub copiar\_datos()
 Dim end\_row As Integer
 Dim i, p, n As Integer


 'search for last row
 end\_row = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
 

 'copy area
 'p = index for positive dataset
 p = 2
 'n = index for negative dataset
 n = 2
 For i = 2 To end\_row - 1

 If Cells(i, 2).Font.Bold = True And Cells(i, 17).Value 0 Then

 Workbooks("test01").Sheets(1).Cells(p, 2).Value = ActiveWorkbook.Sheets(1).Cells(i, 2).Value
 Workbooks("test01").Sheets(1).Cells(p, 4).Value = ActiveWorkbook.Sheets(1).Cells(i, 17).Value
 Workbooks("test01").Sheets(1).Cells(p, 1).Value = ActiveWorkbook.Sheets(1).Cells(i - 1, 1).Value
 Workbooks("test01").Sheets(1).Cells(p, 3).Value = ActiveWorkbook.Sheets(1).Cells(i - 1, 3).Value

 p = p + 1
 End If
 Next i

Workbooks("test01").Activate
End Sub

diesr Code funktioniert soweit, braucht aber (für ca. 9000 einträge) schon sehr lange. Leider gibt es hier aber Monate, in denen es mehrere 10.000 Einträge gibt … manchmal sogar mehr als 65536 -dann eben mit 2 Tabellen-) und da sehe ich die Performance meines Makros schon als sehr bedenklich an!

Ich dachte schon daran, zuerst einfach den kompletten tabelleninhalt zu kopieren, und dann im neuen Sheet zu selektieren und zu löschen, um ein ständiges hin-und herspringen zwischen den workbooks zu vermeiden.

Leider bin ich noch relativ neu in VBA und daher fällt mir leider kein anderer weg ein.

Kennt ihr vielleicht einen Ansatz?

Vielen Dank im Voraus,
cosPhi

Mein bisheriger Code sucht in der 1.Tabelle mit einer
for-schleife nach fett gedruckten zellen (von Excel für die
Subtotalen vorgegeben) und fragt danach das zugehórige saldo
ab. Danach werden die Daten (Kd.Nr etc. aus der Zeile
darüber)in die entsprechenden Tabellen kopiert.

Hi cosPhi,
bei mehr als 65536 Zeilen wäre für dich XL2007 angebracht.
Und Zeilen nie als Integer definieren, sonst hast du bei Zeile 32xxx einen Überlauf.
ungetestet:

Option Explicit

Sub copiar\_datos()
Dim i As Long, p As Long, n As Long, wbt As Workbook
Set wbt = Workbooks("test01")
'copy area ?
p = 2 'p = index for positive dataset
n = 2 'n = index for negative dataset
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveWorkbook
 For i = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 1 'search for last row
 ' If Activesheet.Cells(i, 2).Font.Bold = ... ???
 If Cells(i, 2).Font.Bold = True And Cells(i, 17).Value 0 Then
 wbt.Sheets(1).Cells(p, 2).Value = .Sheets(1).Cells(i, 2).Value
 wbt.Sheets(1).Cells(p, 4).Value = .Sheets(1).Cells(i, 17).Value
 wbt.Sheets(1).Cells(p, 1).Value = .Sheets(1).Cells(i - 1, 1).Value
 wbt.Sheets(1).Cells(p, 3).Value = .Sheets(1).Cells(i - 1, 3).Value
 p = p + 1
 End If
 Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
wbt.Activate
End Sub

Gruß
Reinhard

Hi cosPhi,
bei mehr als 65536 Zeilen wäre für dich XL2007 angebracht.

Das wusste ich nicht.
[Ist aber leider auch nicht meine Entscheidung … :frowning:]

Und Zeilen nie als Integer definieren, sonst hast du bei Zeile
32xxx einen Überlauf.

verdammt !!! Das hätte ich wissen müssen

Vielen herzlichen Dank Reinhard!
Das rast ja jetzt geradezu!!!

Ich bin echt überwältigt, wie schnell du geantwortet hast.
Ohne Menschen wie dich würden wir Anfänger höchstwahrscheinlich NIE etwas zustande bekommen!

CosPhi