Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Problem mein suchen und kopieren von Zellen
23.05.2014 13:21:31
Zellen
Hallo zusammen,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mein suchen und kopieren von Zellen
23.05.2014 13:30:23
Zellen
Hallo,
Private Sub CommandButton2_Click()
Dim ws1 As Worksheet, ws2 As Worksheet, n As Long, pos As Long, _
wb1 As Workbook, wb2 As Workbook
Dim ZelleB As String, ZelleA As String, ZelleH As String, _
ZelleI As String, ZelleZ As String, ZelleK As String, ZelleO As String
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
Application.ScreenUpdating = False
wb2.Activate
ws2.Select
With ws2
For n = 1 To .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
With ws1
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"
End With
End If
Next n
End With
Application.CutCopyMode = False
wb1.Activate
ws1.Select
Application.ScreenUpdating = True
MsgBox ("Fertig")
End Sub

Gruß
Rudi

Anzeige
AW: Problem mein suchen und kopieren von Zellen
23.05.2014 14:13:01
Zellen
Super, funktioniert. Dankeschön. Da war ich ja doch relativ nah dran ^^

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige