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

Zeilen in neues Tabellenblatt kopieren & sortieren

Zeilen in neues Tabellenblatt kopieren & sortieren
04.01.2013 08:32:00
Julia
Hallo,
ich habe vor aus einem Gesamttabellenblatt Daten automatisch in verschieden neue Tabellenblätter kopieren zu lassen und diese dann dort zu sortieren. Am Beispiel:
https://www.herber.de/bbs/user/83243.xlsx
Ich habe meine Liste Einkauf
1. je nachdem in welchen Spalten ein "x" eingetragen wird, soll der Bereich z.B. B-F der Zeile in das entsprechende neue Tabellenblatt eingetragen werden.
2. z.B. im Tabellenblatt "aktuell" sollen die Daten aus Tabellenblatt "Einkauf" mit "x" unter "aktuell" nach Standort sortiert werden.
Da ich dieses kopieren und sortieren an die jeweiligen Tabellenblätter unterschiedlich anpassen muss, brauche ich halt eine Lösung die ich einfach verändern kann.
Hoffe mir kann jemand einen Tipp geben, wie ich dass verwirklichen kann. Die Grundtabelle wird immer erweitert. Danke schonmal.
Grüße Julia

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen in neues Tabellenblatt kopieren & sortieren
04.01.2013 15:05:53
fcs
Hallo Julia,
hier mal 2 Makros, die die Daten aus "Einkauf" nach "aktuell" bzw. "GWG" übertragen.
Gruß
Franz
Sub kopieren_aktuell()
Dim wksEK As Worksheet, ZeileEK As Long, SpalteEK As Long
Dim wksZiel As Worksheet, Zeile_Z As Long, Spalte_Z As Long
Dim SpaltePruef As Long
Set wksEK = ActiveWorkbook.Worksheets("Einkauf")
SpaltePruef = wksEK.Range("K1").Column 'Spalte, die auf "x" geprüft werden soll
Set wksZiel = ActiveWorkbook.Worksheets("aktuell")
Application.ScreenUpdating = False
'Alte Daten im Zielblatt löschen
With wksZiel
Zeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_Z > 1 Then
.Range(.Rows(2), .Rows(Zeile_Z)).Delete
End If
End With
Zeile_Z = 1
With wksEK
For ZeileEK = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If LCase(.Cells(ZeileEK, SpaltePruef).Value) = "x" Then
Zeile_Z = Zeile_Z + 1
For SpalteEK = 1 To 7
'Spalte in Zieltabelle setzen für Werte in Tabelle Einkauf
'Spalte_Z = 0 setzen für Spalten, die nicht übertragen werden sollen
Select Case SpalteEK
Case 1: Spalte_Z = 0 'Bestelldatum
Case 2: Spalte_Z = 2 'Unternehmen
Case 3: Spalte_Z = 3 'Artikel
Case 4: Spalte_Z = 4 'Preis
Case 5: Spalte_Z = 5 'Nr
Case 6: Spalte_Z = 6 'Konto
Case 7: Spalte_Z = 1 'Standort
End Select
If Spalte_Z > 0 Then
wksZiel.Cells(Zeile_Z, Spalte_Z).Value = .Cells(ZeileEK, SpalteEK).Value
End If
Next
End If
Next
End With
If Zeile_Z > 1 Then
With wksZiel
If Zeile_Z > 2 Then
'Daten sortieren
With .Range(.Cells(1, 1), .Cells(Zeile_Z, 6))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
Key2:=.Range("B1"), order2:=xlAscending, _
Key3:=.Range("C1"), order3:=xlAscending, Header:=xlYes
End With
End If
'Leerzeilen und Spaltentitel einfügen für Werte in Spalte A
For Zeile_Z = Zeile_Z To 2 Step -1
If .Cells(Zeile_Z - 1, 1).Value  .Cells(Zeile_Z, 1).Value Then
.Rows(Zeile_Z).Insert
.Cells(Zeile_Z, 1) = .Cells(Zeile_Z + 1, 1)
With .Range(.Cells(Zeile_Z, 1), .Cells(Zeile_Z, 6))
.HorizontalAlignment = xlCenterAcrossSelection
.Interior.Color = 10092543 'hellgelb
End With
If Zeile_Z > 2 Then
.Rows(Zeile_Z).Insert
End If
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub
Sub kopieren_GWG()
Dim wksEK As Worksheet, ZeileEK As Long, SpalteEK As Long
Dim wksZiel As Worksheet, Zeile_Z As Long, Spalte_Z As Long
Dim SpaltePruef As Long
Set wksEK = ActiveWorkbook.Worksheets("Einkauf")
SpaltePruef = wksEK.Range("N1").Column 'Spalte, die auf "x" geprüft werden soll
Set wksZiel = ActiveWorkbook.Worksheets("GWG")
Application.ScreenUpdating = False
'Alte Daten im Zielblatt löschen
With wksZiel
Zeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_Z > 1 Then
.Range(.Rows(2), .Rows(Zeile_Z)).Delete
End If
End With
Zeile_Z = 1
With wksEK
For ZeileEK = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If LCase(.Cells(ZeileEK, SpaltePruef).Value) = "x" Then
Zeile_Z = Zeile_Z + 1
For SpalteEK = 1 To 7
'Spalte in Zieltabelle setzen für Werte in Tabelle Einkauf
'Spalte_Z = 0 setzen für Spalten, die nicht übertragen werden sollen
Select Case SpalteEK
Case 1: Spalte_Z = 0 'Bestelldatum
Case 2: Spalte_Z = 1 'Unternehmen
Case 3: Spalte_Z = 2 'Artikel
Case 4: Spalte_Z = 3 'Preis
Case 5: Spalte_Z = 4 'Nr
Case 6: Spalte_Z = 5 'Konto
Case 7: Spalte_Z = 0 'Standort
End Select
If Spalte_Z > 0 Then
wksZiel.Cells(Zeile_Z, Spalte_Z).Value = .Cells(ZeileEK, SpalteEK).Value
End If
Next
End If
Next
End With
If Zeile_Z > 1 Then
With wksZiel
If Zeile_Z > 2 Then
'Daten sortieren
With .Range(.Cells(1, 1), .Cells(Zeile_Z, 6))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
Key2:=.Range("B1"), order2:=xlAscending, Header:=xlYes
End With
End If
'Leerzeilen und Spaltentitel einfügen für Werte in Spalte A
For Zeile_Z = Zeile_Z To 2 Step -1
If .Cells(Zeile_Z - 1, 1).Value  .Cells(Zeile_Z, 1).Value Then
.Rows(Zeile_Z).Insert
.Cells(Zeile_Z, 1) = .Cells(Zeile_Z + 1, 1)
With .Range(.Cells(Zeile_Z, 1), .Cells(Zeile_Z, 6))
.HorizontalAlignment = xlCenterAcrossSelection
.Interior.Color = 10092543 'hellgelb
End With
If Zeile_Z > 2 Then
.Rows(Zeile_Z).Insert
End If
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub

Anzeige

318 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige