Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
248to252
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
248to252
248to252
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spaltenüberschriften vergleichen u.Daten kopieren

Spaltenüberschriften vergleichen u.Daten kopieren
23.04.2003 15:49:19
Markus
Mein Problem lautet:
In Arbeitsmappe 1 sind Spaltenüberschriften enthalten, in Arbeitsmappe 2 Daten mit Spaltenüberschriften. Das Makro soll jede Überschrift aus Mappe 1 mit Überschriften in Mappe 2 vergleichen und, bei Übereinstimmung, die Daten unter der Überschrift aus Mappe 2 unter die entsprechende Spaltenüberschrift in Mappe 1 übertragen.
Wer kann mir helfen?
Vielen Dank im Voraus!

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

Betreff
Datum
Anwender
Anzeige
Re: Spaltenüberschriften vergleichen u.Daten kopieren
23.04.2003 16:06:48
moe

Hallo Markus

Wo stehen die Spaltenüberschriften ??Jeweils in der 1 Zeile??
Wieviel Spaltenüberschriften sind es ??
Solle die daten direkt drunter kopiert werden

Gruss

moe

Re: Spaltenüberschriften vergleichen u.Daten kopieren
23.04.2003 16:18:53
Markus

Hallo moe!

Spaltenüberschriften stehen jeweils in der ersten Zeile,
es sind mehrere Überschriften in jeder Mappe.
Jede Überschrift in Mappe 1 soll jeweis mit den Überschriften in Mappe 2 verglichen werden, und bei Übereinstimmung soll Datenimport in Mappe 1 direkt unter die entsprechende Überschrift erfolgen.


Re: Spaltenüberschriften vergleichen u.Daten kopieren
23.04.2003 16:45:08
moe

Hallo Markus

Versuch es mal so

Sub find()
Dim rng As Range
Dim x As Integer

'On Error GoTo schluss
Sheets(1).Activate
Range("A1").Activate

For i = 1 To Columns.Count
With Worksheets(2).Range("A1:z1")
m = ActiveCell.Value
Set c = .find(m, LookIn:=xlValues)
firstAddress = c.Address
Sheets(2).Activate
Range(firstAddress).Activate
Range(Selection.Offset(1, 0), Selection.End(xlDown)).Select
Selection.Copy
Sheets(1).Activate
ActiveCell.Offset(1, 0).PasteSpecial
cutcopy = False
End With

schluss:
ActiveCell.Offset(-1, 1).Activate
Next i
End Sub

Gruss
moe

Getestet unter excel 2000 und klappt

Gruss

moe

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige