Daten an best. Stelle in anderer Datei einfügen

Forumthread: Daten an best. Stelle in anderer Datei einfügen

25.02.2016 15:25:46

Stina

Hallo zusammen,
ich bitte um eure Hilfe:
Ich habe einen Excel-Datensatz (Tabelle1), der sich monatlich ändert, also immer unterschiedlich viele Zeilen hat. Die Spaltenanzahl bleibt immer gleich (A-V).
Wenn in Spalte A ein bestimmter Name steht z.B. "Baum Rot", dann sollen alle Zeilen, in denen dies der Fall ist, ganz (A:V) kopiert werden und in einer bestehenden Vorlagendatei (Vorlage.xlsx) an der Stelle eingefügt werden, an der genau dieser Name in Spalte A steht.
Vorsicht: in der Vorlagentabelle steht nur einmalig der Name, die darunterliegenden Zeilen sind leer.
Das Ganze soll dann mehrmals für andere Namen wiederholt werden.
Könnt ihr mir helfen?
Danke und liebe Grüße
Stina

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten an best. Stelle in anderer Datei einfügen

25.02.2016 16:54:43

fcs

AW: Daten an best. Stelle in anderer Datei einfügen

25.02.2016 16:54:43

fcs

Hallo Stina,
schau mal, ob du mit dem folgenden Makro klar kommst.
Das Makro musst du in der Datei mit den Monatsdaten in einem allgemeinen Modul einbauen oder in deiner persönlichen Makroarbeitsmappe.
Die Vorlage-Datei sollte geschlossen sein. Das Verzeichnis der Datei musst du im Code anpasen.
Gruß
Franz

Sub Transfer_Monatsdaten()
Dim wks_Q As Worksheet
Dim wkb_Z As Workbook
Dim wks_Z As Worksheet
Dim rngZiel As Range
Dim colA As New Collection, colItem
Dim Zeile As Long, Zeile_Z As Long
On Error GoTo Fehler
With Application
.ScreenUpdating = False
End With
'Quelltabelle setzen
Set wks_Q = ActiveWorkbook.Worksheets("Tabelle1")
'Vorlage schreibgeschützt Öffnen - Verzeichnis der Vorlage anpassen!!!!
Set wkb_Z = Application.Workbooks.Open("D:\Test\Vorlage.xlsx", ReadOnly:=True)
Set wks_Z = wkb_Z.Worksheets(1)
'Begriffe in Spalte A der Quelle sammeln ohne doppelte
With wks_Q
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile, 1).Text  "" Then
colA.Add Item:=.Cells(Zeile, 1).Text, Key:=.Cells(Zeile, 1).Text
End If
Next
End With
'gefundene Begriffe abarbeiten
For Each colItem In colA
'Zeile mit Begriff in Zieltabelel (Vorlage) ermitteln
With wks_Z
Set rngZiel = .Range("A:A").Find(what:=colItem, LookIn:=xlValues, lookat:=xlWhole)
End With
If Not rngZiel Is Nothing Then
Zeile_Z = rngZiel.Row
With wks_Q
'Zeilen mit Begriff in Quelle suchen und nach Ziel kopieren
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile, 1).Text = colItem Then
.Range(.Cells(Zeile, 1), .Cells(Zeile, 22)).Copy wks_Z.Cells(Zeile_Z, 1)
Zeile_Z = Zeile_Z + 1
End If
Next
End With
Else
MsgBox "Eintrag """ & colItem & """ in Zieltabelle nicht gefunden!"
End If
Next
Fehler:
With Err
Select Case .Number
Case 0
Case 457
'Eintrag für Collection mehrfach
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Daten an best. Stelle in anderer Datei einfügen

Forumthread: Daten an best. Stelle in anderer Datei einfügen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread