Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
960to964
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
960to964
960to964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spalten kopieren mit vlookup

Spalten kopieren mit vlookup
25.03.2008 19:54:03
Born
Hallo Excellanten,
könnte bitte jemand den Schlauch entfernen, auf dem ich stehe.
Ich möchte mit einem einfachen VBA-Script Werte in Spalten von
einem Tabellenblatt in ein anderes kopieren. Aber, beim Wotan,
es läßt sich nicht zwingen.
Wäre jemand von Euch so nett mir unter meine unerfahrenen Arme
zu greifen?
Hier ist das Beispiel: Die Werte in Spalte A und B unter den Überschriften
Saison und Spieltag sollen in das Tabellenblatt "Spiel" unter den
selben Überschriften einkopiert werden:
Userbild
Und hier die Excel-Datei zum Fall:

Die Datei https://www.herber.de/bbs/user/51003.xls wurde aus Datenschutzgründen gelöscht

Herzlichen Dank für Eure Hilfe,
Born

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

Betreff
Datum
Anwender
Anzeige
AW: Spalten kopieren mit vlookup
25.03.2008 20:05:32
Beate
Hallo Born,
ich würde es so machen, die Ausgangstabelle heißt "Tabelle1":
Sub kopieren()
    Sheets("Tabelle1").Columns("B:B").Copy Sheets("Spiel").Columns("A:A")
    Sheets("Tabelle1").Columns("A:A").Copy Sheets("Spiel").Columns("B:B")
    Application.CutCopyMode = False
End Sub


Ich weiß nicht, was deine Frage mit vlookup zu tun haben soll?
Gruß,
Beate

Anzeige
AW: Danke, aber es muß anders gehen
25.03.2008 20:24:00
Born
Hallo Beate,
danke fürs Mitdenken, aber leider ist es nicht ganz so einfach.
1. Mehr Spalten als 2:
Es gibt mehr Spalten als die
beiden. Die Überschriften sind immer gleich, aber sie sind oft an anderer Stelle. Das heißt, die
Spalte "Saison" kann mal in Spalte A, mal in Spalte E stehen. Deshalb muß es eine Lösung mit
Vlookup geben.
2. Nicht ganze Spalte kopieren:
Und die ganze Spalte zu kopieren, ist zwar möglich, aber nicht so elegant, will sagen, ganze
Spalten zu kopieren dauert ziemlich lange. Deshalb suche ich nach einer Lösung, die nur
1000 Zeilen kopiert, wenn nur 1000 Zeilen gefüllt sind.
Es müßte also anders gehen.
Gruß,
Born

Anzeige
AW: Danke, aber es muß anders gehen
25.03.2008 20:53:00
Erich
Hallo Born,
probier mal

Option Explicit
Sub kopieren2()
Dim wsZ As Worksheet, ii As Byte, varSp
Set wsZ = Sheets("Spiel")
With Sheets("Tabelle1")
For ii = 1 To 2
varSp = Application.Match(.Cells(1, ii), wsZ.Rows(1), 0)
If IsNumeric(varSp) Then
.Columns(ii).Copy wsZ.Columns(varSp)
Else
MsgBox "'" & .Cells(1, ii) & "' fehlt in Blatt " & wsZ.Name
End If
Next ii
End With
End Sub

Das geht mit Match statt VLookup. Dass ganze Spalten kopiert werden,
sollte die Geschwindigkeit nicht sonderlich beeinflussen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
@Erich
25.03.2008 22:01:24
Beate
Hallo Erich,
dein Code funktioniert sehr gut (insofern die Überschrift im Blatt Spiel in Zeile 1 steht, aber das scheint ja hier so zu sein).
Aber deine Variablendeklaration ii As Byte solltest du überdenken. Nepumuk hat da in seinem Wort zum Sonntag was zu geschrieben:
https://www.herber.de/forum/archiv/952to956/t954760.htm#954760
Daher wäre besser: ii As Long
Gruß,
Beate

AW: Danke, aber es muß anders gehen
25.03.2008 21:14:32
Beate
Hallo,
ich hänge mal eine Beispieldatei an. Das Makro sucht die beiden Überschriften in der anderen Tabelle, die irgendwo auch auseinanderliegend sein können und kopiert die Bereiche in passender Größe darunter:
Sub kopieren()
    Sheets("Spiel").Select
    ActiveSheet.UsedRange.Find(What:="Spieltag", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Tabelle1").Range("=OFFSET('Tabelle1'!$B$1,,,COUNTA('Tabelle1'!$B:$B),1)").Copy
    ActiveSheet.Paste
    '------------------------
    ActiveSheet.UsedRange.Find(What:="Saison", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Tabelle1").Range("=OFFSET('Tabelle1'!$A$1,,,COUNTA('Tabelle1'!$A:$A),1)").Copy
    ActiveSheet.Paste
End Sub


Anbei die Beispieldatei:
https://www.herber.de/bbs/user/51006.xls
Gruß,
Beate

Anzeige
AW: Danke, aber es muß anders gehen
26.03.2008 15:17:00
Born
Hallo Beate,
endlich komme ich dazu es auszuprobieren. Es funktioniert auch ganz gut,
es gibt aber eine Schwierigkeit:
Mit diesem Script sind die Spalten AUS denen importiert/kopiert wird fix und
die, IN die hineinkopiert werden sind frei wählbar. Ich meine damit, daß die
Daten dahin kopiert werden, wo die passende Überschrift gefunden wird.
Leider ist es in Wirklichkeit so, daß die Tabelle IN die hineinkopiert wird, festgelegte
Überschriften und Spalten hat, die Tabelle AUS der herauskopiert wird zeichnet
sich dadurch aus, daß die Überschriften immer mal in anderen Spalten sein können.
Das heißt "Saison" kann mal die Spalte B betiteln, aber auch mal die Spalte F.
Jetzt müßte das umgedreht werden. Geht das?
Herzlichen Dank und Grüße aus Berlin,
Born

Anzeige
AW: Danke, aber es muß anders gehen
26.03.2008 16:20:00
Beate
Hallo,
Sub kopieren2()
    Sheets("Tabelle1").Select
    ActiveSheet.UsedRange.Find(What:="Spieltag", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + 1000, ActiveCell.Column)).Copy Sheets("Spiel").Range("A1")
    '------------------------
    ActiveSheet.UsedRange.Find(What:="Saison", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + 1000, ActiveCell.Column)).Copy Sheets("Spiel").Range("B1")
End Sub


Hier werden immer nur 1000 Zeilen kopiert, den Wert kannst du dir anpassen.
Gruß,
Beate

Anzeige
AW: Danke, aber es muß anders gehen
26.03.2008 17:39:50
Born
Yes, yes, yes. That's it!
So funktioniert es wunderbar. Danke sehr.
Born

AW: Es geht anders
26.03.2008 17:28:53
Erich
Hallo Born,
hier gibst du die Überschriften vor, das Makro sucht die Spalten
in der Quell- und der Zieltabelle:

Option Explicit
Sub kopieren2()
Dim strSp(1) As String, wsZ As Worksheet, ii As Long, varSpZ, varSpQ, lngQ As Long
strSp(0) = "Saison"
strSp(1) = "Spieltag"
Set wsZ = Sheets("Spiel")
With Sheets("Tabelle1")
For ii = 0 To 1
varSpQ = Application.Match(strSp(ii), .Rows(1), 0)
varSpZ = Application.Match(strSp(ii), wsZ.Rows(1), 0)
If IsNumeric(varSpQ) And IsNumeric(varSpZ) Then
lngQ = .Cells(.Rows.Count, varSpQ).End(xlUp).Row - 1
.Cells(2, varSpQ).Resize(lngQ).Copy wsZ.Cells(2, varSpZ)
Else
MsgBox "'" & strSp(ii) & "' nicht gefunden in einer der Tabellen!"
End If
Next ii
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige