Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1432to1436
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

Daten übertragen

Daten übertragen
09.07.2015 10:22:23
Michael
Hallo Zusammen,
ich habe folgendes Problem:
In einer Arbeitsmappe habe ich in einem Tabellenblatt eine große Datenbank (ca. 200 Spalten). Die Datensätze sind durch eine eindeutige ID (Buchstaben & Zahlen) gekennzeichnet. In einem anderen Tabellenblatt habe ich wöchentlich, aus einem Import, ca. 20 neue Spalten mit neuen Daten. Bisher habe ich das ganze manuell übertragen. Also Zielspalte gesucht und dann rein kopiert.
Mit einem Makro kriege ich das einfach nicht, weil ich die Zielspalte nicht ermitteln kann.
Vielen Dank für Eure Unterstützung
Michael

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten übertragen
09.07.2015 10:43:57
JoWE
Hallo Michael,
meinst Du so?
zielspalte = Sheets("Tabelle1").cells(1,columns.count).end(xltoleft).column+1
(findet die letzte nicht leere Zelle in der Zeile 1, und gibt die Nummer der folgenden Spalte aus)
Gruß
Jochen

so leider nicht
09.07.2015 10:48:48
Michael
Hallo Jochen,
da ich ca. 5 bis 10 Spalten mit übertragen muss, soll zuerst die Spalte ermittelt werden, in der sich die erste ID der zu übertragenden Spalten befindet. Dann die erste Spalte in die DB übertragen usw. bis alle Spalten übertragen sind.

AW: so leider nicht
09.07.2015 11:07:04
hary
Moin
Hier mal mein Ansatz(ungetestet). Ich geh davon aus das im Importblatt die ID's in A1 beginnend nach rechts stehen.
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim letzte As Long
Dim i As Long
Dim a As Variant
Set wksQ = Worksheets("Import") '--Name anpassen
Set wksZ = Worksheets("Daten") '--Name anpassen
For i = 1 To wksQ.Cells(1, Columns.Count).End(xlToLeft).Column '--ID in Zeile 1
a = Application.Match(wksQ.Cells(1, i), wksZ.Rows(1), 0) 'sucht ID in Zielblatt Zeile 1
If IsNumeric(a) Then 'wenn gefunden
letzte = wksZ.Cells(Rows.Count, a).End(xlUp).Row + 1 'letzte freie Zelle in Id Spalte
wksQ.Cells(2, i).Resize(wksQ.Cells(Rows.Count, i).End(xlUp).Row, 1).Copy wksZ.Cells( _
letzte, a) ' kopiert von nach
Else
MsgBox "ID nicht vorhanden"
End If
Next

Ansonsten mal eine bsp.-Mappe hochladen.
gruss hary

Anzeige
AW:Code getestet?
09.07.2015 11:39:29
hary
Moin
Hast du meinen Code auch getestet?
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim letzte As Long
Dim i As Long
Dim a As Variant
Set wksQ = Worksheets("Quelle") '--Name anpassen
Set wksZ = Worksheets("Ziel") '--Name anpassen
For i = 2 To wksQ.Cells(1, Columns.Count).End(xlToLeft).Column '--ID in Zeile 1
a = Application.Match(wksQ.Cells(1, i), wksZ.Rows(1), 0) 'sucht ID in Zielblatt Zeile 1
If IsNumeric(a) Then 'wenn gefunden
letzte = wksZ.Cells(Rows.Count, a).End(xlUp).Row + 1 'letzte freie Zelle in Id Spalte
wksQ.Cells(2, i).Resize(wksQ.Cells(Rows.Count, i).End(xlUp).Row, 1).Copy wksZ.Cells( _
letzte, a) ' kopiert von nach
End If
Next

gruss hary

Anzeige
AW: AW:Code getestet?
09.07.2015 11:44:42
Michael
Hallo Harry, es kam immer die Meldung: ID nicht vorhanden.
Gruß
Michael

Meldung is weg, aber übertragt nicht
09.07.2015 11:48:46
Michael
Hallo Harry,
ich habe Deinen modifizierten Code eingebaut und getestet. Die Infobox mit der Meldung: "ID nicht vorhanden" kommt jetzt nicht mehr. Die Daten werden aber nicht übertragen.
Gruß
Michael

Funktioniert!
09.07.2015 11:56:12
Michael
Hallo Hary,
... die Daten wurden unten angefügt. Das hatte ich nicht gesehen. Die kleine Änderung, das es oben eingesetzt wird, kriege ich locker hin.
Vielen Dank für Deine Geduld und Unterstützung.
Gruß
Michael

AW: Nun, da wäre eine Beispieltabelle hilfreich
09.07.2015 11:07:31
JoWE
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige