Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1216to1220
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
Inhaltsverzeichnis

Register in Mappe nach Auswahl kopieren

Register in Mappe nach Auswahl kopieren
eric1
Hallo,
das geht doch sicher einfacher als ich das mache (es funktioniert) :
' es werden alle Zeilen des Registers 1 in ein anderes Register kopiert
' wenn in Spalte A 1 steht, dann in Register 2
' wenn in Spalte A 2 steht, dann in Register 3 usw.
' es muss eine Aufteilung nach Spalte A in ca. 30 Register erfolgen

Sub Zeilen_kopieren()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 1
For i = 1 To 65000
With Worksheets(1)
If .Cells(i, 1) = "1" Then
.Rows(i).Copy _
Destination:=Worksheets(2).Rows(a)
a = a + 1
End If
End With
Next i
a = 1
For i = 1 To 65000
With Worksheets(1)
If .Cells(i, 1) = "2" Then
.Rows(i).Copy _
Destination:=Worksheets(2).Rows(a)
a = a + 1
End If
End With
Next i
a = 1
For i = 1 To 65000
With Worksheets(1)
If .Cells(i, 1) = "3" Then
.Rows(i).Copy _
Destination:=Worksheets(3).Rows(a)
a = a + 1
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Vielen Dank im voraus für Eure Hilfe ERIC


		

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Register in Mappe nach Auswahl kopieren
26.05.2011 23:30:37
Mustafa
Hallo Eric,
so vielleicht :
Sub Kopierennach()
Dim lngZeile As Long
Dim Zelle As Range
Dim Wks1, Wks2, Wks3, Wks4
Set Wks1 = Worksheets("Tabelle1")
Set Wks2 = Worksheets("Tabelle2")
Set Wks3 = Worksheets("Tabelle3")
Set Wks4 = Worksheets("Tabelle4")
lngZeile = Wks1.Cells(Rows.Count, 1).End(xlUp).Row
For Each Zelle In Wks1.Range(Wks1.Cells(2, 1), Wks1.Cells(lngZeile, 1))
Select Case Zelle
Case 1
Zelle.EntireRow.Copy Destination:=Wks2.Cells(Wks2.Rows.Count, 1).End(xlUp).Offset(1, 0)
Case 2
Zelle.EntireRow.Copy Destination:=Wks3.Cells(Wks3.Rows.Count, 1).End(xlUp).Offset(1, 0)
Case 3
Zelle.EntireRow.Copy Destination:=Wks4.Cells(Wks4.Rows.Count, 1).End(xlUp).Offset(1, 0)
Case Else
End Select
Next
End Sub
Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.
Anzeige
AW: Register in Mappe nach Auswahl kopieren
27.05.2011 18:00:41
eric1
Hallo,
vielen Dank, das funktioniert prima, hab es noch etwas erweitert, z.B. kopiere wenn in spalte 2 = 99 steht in wks ...
bei ca. 30 Registern dauert es eben ein wenig !
DANKE ERIC
Danke für die Rückmeldung owT
27.05.2011 22:58:17
Mustafa

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige