Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Macro zum kopieren bestimmter Zellen in einer Tab.

Macro zum kopieren bestimmter Zellen in einer Tab.
01.02.2008 11:07:00
Martin
Hallo Leute!
Ich habe folgendes Problem.
Ich habe aus einer Datenbank eine Tabelle mit bis zu 3000 Positionen in dementsprechend vielen Zeilen.
In der Spalte A stehen Zahlen zwischen 0 und 100. Es kommen jedoch nicht alle Zahlen von 1 bis 100 vor.
Es können nun 20 Zeilen mit der Nummer 0 sein, 37 Zeilen mit der Nummer 7, 15 Zeilen mit der Nummer 32, usw… In der Spalte F steht die Beschreibung der Position. In der Spalte M steht der dazugehörige Eurobetrag. Dieser Eurobetrag ist manchmal allerdings 0 da diese Positionen dann Überschriften sind.
Ich möchte nun mit einem Makro folgendes erreichen.
Es soll mir in der Spalte AA alle Werte aus der Spalte F untereinander eintragen, welche die gleiche Zahl aus der Spalte A besitzen und die Werte in der Spalte M NICHT 0 sind.
In die Spalte AB soll es mir dann untereinander die nächst höhere Zahl aus Spalte A dastehen und die Werte in der Spalte M wieder NICHT 0 sind.
Also in etwa so: (Die Nummern sollten aber durch die Beschreibung aus der Spalte F ersetzt werden)
AA AB AC AD
0 7 32 48
0 7 32 48
0 7 32 48
0 7 32
0 7 32
0 7
0 7
0
0
Das Makro sollte am besten automatisch ausgeführt werden wenn ich das Tabellenblatt verlasse oder wenn ich ein bestimmtes Tabellenblatt anklicke.
Danke schon jetzt für eure Hilfe.
lg
Martin

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Macro zum kopieren bestimmter Zellen in einer
01.02.2008 22:33:00
fcs
Hallo Martin,
hier mein Lösungsvorschlag.
Die Prozedur "DatenAufbereiten" fügst du im VBA-Editor in einem allgemeinen Modul ein;
die Activate- oder die Deactivate-Prozedur unter dem entsprechenden Tabellenblatt.
Gruß
Franz

Private Sub Worksheet_Activate()
Call DatenAufbereiten(Worksheets("Tab1")) 'Namen des Tabellenblatts ggf. anpassen
End Sub
Private Sub Worksheet_Deactivate()
Call DatenAufbereiten(Me)
End Sub
Sub DatenAufbereiten(wks As Worksheet)
'wks = Worksheet in dem Aktion ausgeführt werden soll
Dim Zeile As Long, Spalte As Integer, Spalte1 As Integer, rngTitel As Range
Application.ScreenUpdating = False
Spalte1 = 27 'Spalte AA, Spalte ab der Daten eingefügtb werden sollen
Zeile = 1 '1. auszuwertende Zeile
With wks
Set rngTitel = .Cells(1, Spalte1)
'ggf. vorhanden Daten ab Spalte AA löschen
If Not IsEmpty(rngTitel) Then
.Range(rngTitel, .Cells(1, .Columns.Count).End(xlToLeft)).EntireColumn.ClearContents
End If
rngTitel.Value = .Cells(Zeile, 1)
For Zeile = Zeile To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile, 13).Value  0 Then
'Prüfen ob Nr aus Spalte A bereits im Titelbereich vorhanden
Set Zelle = rngTitel.Find(what:=.Cells(Zeile, 1).Value, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle Is Nothing Then
'neuer Eintrag
Spalte = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
Set rngTitel = .Range(.Cells(1, Spalte1), .Cells(1, Spalte))
.Cells(1, Spalte).Value = .Cells(Zeile, 1).Value
Else
Spalte = Zelle.Column
End If
.Cells(.Rows.Count, Spalte).End(xlUp).Offset(1, 0).Value = _
.Cells(Zeile, 6).Value
End If
Next
'Spalten nach 1. Zeile Sortieren
rngTitel.EntireColumn.Sort Key1:=rngTitel.Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=xlSortColumns, Orientation:=xlLeftToRight
'Titelzeile löschen
rngTitel.Delete Shift:=xlShiftUp
Application.ScreenUpdating = True
End With
End Sub


Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige