Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA gezieltes Kopieren, Suchen & Einfügen

VBA gezieltes Kopieren, Suchen & Einfügen
Thorsten
Hallo zusammen,
vor ein paar Jahren bin ich das erste mal auf das Herber-Excel Forum gestoßen, ihr habt mir immer klasse Dienste erwiesen und alle Herausforderungen konnten gemeinsam gelöst werden.
Nun bin ich wieder da und hab auch was mitgebracht:
Ich möchte per Makro aus einem Tabellenblatt Werte aus einer Spalte kopieren und gezielt in einem anderen Tabellenblatt wieder als Werte einfügen. Dabei enthält die Überschrift der Quelle eine Formel, die ein vorab ausgewähltes Datum zeigt (Monat/Jahr). Die Zieltabelle enthält 12 Spalten (1 x je Monat) und die passende Überschrift (Monat/Jahr).
Das Makro soll nach dem kopieren aus der Quelltabelle in der Zieltabelle den korrespondierenden Monat finden und die Daten als Werte dort einfügen.
Würde mich sehr über Eure Ideen freuen, gerne kann ich auch eine Beispieldatei zur verfügung stellen.
Gruß aus dem Rheinland,
Thorsten

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zusatzfragen
25.05.2011 10:46:48
fcs
Hallo Thorsten,
ich hab noch ein paar Fragen:
1. Welche Spalte in der Quelle soll kopiert werden?
2. Welche Zeilen in der Spalte sollen in der Quelle kopiert werden?
3. In welche Zeile(n) sollen die Daten aus der Quelle in der Zieltabelle eingefügt werden?
4. Name der Zieltabelle
Gruß
Franz
AW: Zusatzfragen
25.05.2011 11:35:39
Thorsten
Hallo Franz,
ich habe mal eine TEST.xls angehängt mit 2 Tabellenblättern.
Alle Werte der Spalte T aus "TEST NEU" sollen als Werte in die passende Monatsspalte der Tabelle "TEST NEU 2011" (hier also die Spalte H).
Das Makro soll dabei aufgrund der Angabe in TAbelle "TEST NEU", Zelle T3 selbständig prüfen in welche Spalte (D-O) die Daten in der Tabelle "TEST NEU" eingefügt werden müssen.
ACHTUNG: #Quellzeilen und Zielzeilen sind nicht identisch!
https://www.herber.de/bbs/user/75007.xls
Hoffe dies hilft so,
Thorsten
Anzeige
AW: Zusatzfragen
26.05.2011 02:44:34
fcs
Hallo Thorsten,
leider ist der Zeilenauf in den beiden Blättern nicht identisch (In Blatt "TEST NEU" sind Leerzeilen zwischen einzelnen Positionen, im Blatt "TEST NEU 2011" nicht.
Dadurch ist es aufwendiger zu übertragen, da eine Prüfung eingebaut und zeilenweise übertragen werden muss.
Gruß
Franz
'##############################################################
'# Windows Vista  -       Excel 2007    -        VBA 6.5.1053 #
'# fcs                                             2011-05-26 #
'# Modul: Allgemeines Modul                                   #
'# Überträgt Spalteninhalte gemäß Suchkriterium in Zielspalte #
'# Makros sollten auch unter Excel 2003 lauffähig sein        #
Sub DatenUebertragen()
'Variante, wenn im Zielblatt alle Positionen aus Spalte B der Quelle _
vorhanden sind, aber keine Leerzeilen zwischen den Positionen.
Dim wksZiel As Worksheet, wksQuelle As Worksheet
Dim sFind As String, rFind As Range, Spalte_Z As Long, Spalte_Q As Long
Dim Spalte_ZTQ As Long, Zeile_TQ As Long, Zeile_TZ As Long
Dim Zeile_Q As Long, Zeile_Z As Long
Set wksQuelle = Worksheets("TEST NEU") ' oder ActiveSheet
Set wksZiel = Worksheets("TEST IST 2011")
'Zeile mit Spaltentiteln in Quelle
Zeile_TQ = 3
'Spalte mit den zu übertragenden Werten
Spalte_Q = 20 'Spalte T
'Spalte mit den Zeilentiteln in Quelle
Spalte_ZTQ = 2 'Spalte B
'Zeile mit Spaltentiteln in Ziel
Zeile_TZ = 2
'zu suchender Begriff
sFind = wksQuelle.Range("T3")
'führende Null beim Monat ggf. entfernen
sFind = Replace(sFind, " 0", " ", 1)
With wksZiel
Set rFind = .Rows(Zeile_TZ).Find(What:=sFind, Lookat:=xlWhole, LookIn:=xlValues)
End With
If rFind Is Nothing Then
MsgBox "Monat """ & sFind & """ wurde in Zeile " & Zeile_TZ & " im Blatt " _
& wksZiel.Name & " nicht gefunden!"
Else
Spalte_Z = rFind.Column
'Altdaten in Zielspalte löschen
With wksZiel
If .Cells(.Rows.Count, Spalte_Z).End(xlUp).Row > Zeile_TZ + 1 Then
.Range(.Cells(Zeile_TZ + 2, Spalte_Z), _
.Cells(.Rows.Count, Spalte_Z).End(xlUp)).ClearContents
End If
End With
With wksQuelle
Zeile_Z = Zeile_TZ + 1
'In Quelle zeilenweise prüfen ob Inhalt in Spalte B vorhanden und _
ggf. Wert nach Ziel übertragen
For Zeile_Q = Zeile_TQ + 2 To .Cells(.Rows.Count, Spalte_ZTQ).End(xlUp).Row
If .Cells(Zeile_Q, Spalte_ZTQ)  "" Then
Zeile_Z = Zeile_Z + 1
wksZiel.Cells(Zeile_Z, Spalte_Z).Value = .Cells(Zeile_Q, Spalte_Q).Value
End If
Next
End With
Application.CutCopyMode = False
End If
End Sub
Sub DatenUebertragen_Variante()
'Variante, wenn der Zeilenaufbau in beiden Blättern identisch ist
Dim wksZiel As Worksheet, wksQuelle As Worksheet
Dim sFind As String, rFind As Range, Spalte_Z As Long, Spalte_Q As Long
Dim Zeile_TQ As Long, Zeile_TZ As Long
Set wksQuelle = Worksheets("TEST NEU") ' oder ActiveSheet
Set wksZiel = Worksheets("TEST IST 2011")
'Zeile mit Spaltentiteln in Quelle
Zeile_TQ = 3
Spalte_Q = 20 'Spalte T
'Zeile mit Spaltentiteln in Ziel
Zeile_TZ = 2
sFind = wksQuelle.Range("T3")
'führende Null beim Monat ggf. entfernen
sFind = Replace(sFind, " 0", " ", 1)
With wksZiel
Set rFind = .Rows(Zeile_TZ).Find(What:=sFind, Lookat:=xlWhole, LookIn:=xlValues)
If rFind Is Nothing Then
MsgBox "Monat """ & sFind & """ wurde in Zeile " & Zeile_TZ & " im Blatt " _
& wksZiel.Name & " nicht gefunden!"
Else
Spalte_Z = rFind.Column
'Altdaten in Zielspalte löschen
If .Cells(.Rows.Count, Spalte_Z).End(xlUp).Row > Zeile_TZ + 1 Then
.Range(.Cells(Zeile_TZ + 2, Spalte_Z), _
.Cells(.Rows.Count, Spalte_Z).End(xlUp)).ClearContents
End If
With wksQuelle
'Quelldaten kopieren, falls Daten vorhanden sind
If .Cells(.Rows.Count, Spalte_Q).End(xlUp).Row > Zeile_TQ + 1 Then
.Range(.Cells(Zeile_TQ + 2, Spalte_Q), .Cells(.Rows.Count, Spalte_Q).End(xlUp)).Copy
wksZiel.Cells(Zeile_TZ + 2, Spalte_Z).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End With
End If
End With
End Sub

Anzeige
AW: Zusatzfragen
26.05.2011 11:52:11
Thorsten
Hallo Franz,
vielen, herzlichen Dank....habe die erste Variante gemnommen und werde einfach die Zeilen anpassen.
Funktioniert super,
Thorsten
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge