ich habe folgenden Code, um in einer Excel Datei (alt, und da immer der 1. Reiter) noch nicht übertragene Zellen mit einer bestimmten Zuordnung in eine andere Excel zu kopieren. Hierbei soll in der Übersichtsdatei (Neu) die kopierten Zeilen bzw. Zellen unten angehängt werden.
Leider weiß ich nicht warum, aber Excel kopiert die Zellen immer von der alten Liste unterhalb der letzten befüllten Zeile in der alten Liste. Dabei soll es in die neue Übersichtsdatei kopiert werden.
Könnt ihr mir helfen? Ich glaube das Problem liegt irgendwo nach der ---- Linie.
Vielen Dank schonmal im Voraus.
Private Sub CommandButton2_Click()
Dim ws1 As Worksheet, ws2 As Worksheet, n As Long, pos As Long, wb1 As Workbook, wb2 As _
Workbook
Set wb1 = Workbooks("TestUebersicht.xlsm") 'Neu
Set wb2 = Workbooks("35up.xlsm") 'Alt
Set ws1 = wb1.Worksheets("Dokumentation_35up") 'Neu
Set ws2 = wb2.Worksheets(1) 'Alt
pos = 1
Dim ZelleB As String, ZelleA As String, ZelleH As String, ZelleI As String, ZelleZ As String, _
_
ZelleK As String, ZelleO As String
Application.ScreenUpdating = False
wb2.Activate
ws2.Select
With ws2
For n = 1 To ws2.Cells(65536, 28).End(xlUp).Row
If .Cells(n, 28) Like "Nein" Then 'Spalte AB ist die Zeile in der überprüft werden soll. _
_
Wenn dort "nein" steht, dann soll in die andere Liste kopiert werden
ZelleB = .Cells(n, 2) 'Hier werden die Elemente herauskopiert
ZelleA = .Cells(n, 1)
ZelleH = .Cells(n, 8)
ZelleI = .Cells(n, 9)
ZelleZ = .Cells(n, 26)
ZelleK = .Cells(n, 11)
ZelleO = .Cells(n, 15)
.Cells(n, 28) = "Ja" 'Wenn kopieren der Zeile beendet, dann ist wird AB auf "Ja" _
gesetzt
wb1.Activate
ws1.Select 'Hier hineinkopieren
pos = .Range("B65536").End(xlUp).Row + 1
.Cells(pos, 1) = "Test"
'ActiveSheet.Cells(pos, 1).Select ?
.Cells(pos, 2) = ZelleB
.Cells(pos, 4) = ZelleA
.Cells(pos, 8) = ZelleH
.Cells(pos, 9) = ZelleI
.Cells(pos, 12) = ZelleZ
.Cells(pos, 13) = ZelleK
.Cells(pos, 18) = ZelleO
.Cells(pos, 21) = "Ja"
wb2.Activate
ws2.Select
'pos = pos + 1
End If
wb2.Activate
ws2.Select
Next n
End With
Application.CutCopyMode = False
wb1.Activate
ws1.Select
Application.ScreenUpdating = True
MsgBox ("Fertig")
End Sub