Excel daten kopieren & weitergeben

Hallo an alle VBA Könner und Begeisterten :)
Ich habe nur sehr bescheidene VBA Kenntnisse und bin daher auf eure Hilfe angewiesen.
Die Problemstellung lautet wie folgt:
Es gibt eine Excel Datei mit dem Namen "Datenbank" in der alle Messwerte dokumentiert sind (in Tabelle 1). Die ganzen Werte sind dabei einer bestimmten System ID (System Identifikation) zugeordnet.
Weiters gibt es noch eine zweite Excel mit dem Namen "Report". In dieser Excel wird dann der Report generiert. Durch öffnen der Excel "Report" drücke ich auf einen CommandButton. Durch drücken auf den Button öffnet sich die Excel "Datenbank" und kurz darauf öffnet sich darin ein Fenster mit der Fragestellung (Welche System-ID möchten Sie sich anzeigen lassen?. Durch eintippen der System-ID und bestätigen mit Enter, durchsucht das Makro alle Zeilen bis die eingetippte System-ID gefunden ist und dabei nur die "Treffer" Zeile angezeigt wird. Nun sollten die Zellen der "Datenbank" B4, D4, F4, G4 in die Excel "Report" kopiert werden. Die Zelle F4 (Datenbank) sollte in die Zelle A9 (Report) kopiert werden.D4 in B9, B4 in C9 und G4 in D9.
Nun ist der erste Vorgang abgeschlossen und durch erneutes drücken auf den CommandButton startet der Vorgang wieder von vorne. Jene Messwerte die in die Excel Report kopiert werden, sollten nun immer fortlaufend untereinander abgelegt werden.
(PS: die beiden Excel Blätter liegen auf dem gleichen Pfad).
Siehe Anhang :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton2_Click() Dim Zelle As Range Dim Name As String Workbooks.Open "C:\Datenbank.xlsx" Name = InputBox("Bitte System-ID eingeben!") If Name = "" Then Exit Sub ActiveSheet.Range("F1:F5000").Select For Each Zelle In Selection If Zelle = Name Then Zelle.Select Zelle.Interior.ColorIndex = 3 Exit Sub End If Next Zelle MsgBox "Name nicht vorhanden!" End Sub

Dim Zelle As Range Dim Name As String Dim freieZeile As Long Workbooks.Open "C:\Datenbank.xlsx" Name = InputBox("Bitte System-ID eingeben!") If Name = "" Then Exit Sub ActiveSheet.Range("F1:F5000").Select For Each Zelle In Selection If Zelle = Name Then Zelle.Select Zelle.Interior.ColorIndex = 3 With ThisWorkbook.Sheets("?") 'Blattname einf?gen!! freieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(freizeile, 1).Value = Zelle.Value .Cells(freieZeile, 2).Value = Zelle.Offset(0, -3).Value .Cells(freieZeile, 3).Value = Zelle.Offset(0, -2).Value .Cells(freieZeile, 4).Value = Zelle.Offset(0, 1).Value End With Exit Sub End If Next Zelle MsgBox "Name nicht vorhanden!"

Hallo Patrick,
der Fehler war nur ein Tippfehler in einer Variablen. Deshalb unbedingt immer mit Option Explicit am Anfang arbeiten, dann wäre das direkt aufgefallen.
Habe mir erlaubt, deinen Code in eine keinesfalls perfekte, aber etwas zuverlässigere Form zu bringen. So wie ich es verstanden habe, soll nur der erste Treffer kopiert werden? Dann bräuchtest du keine For Schleife zu bemühen, sondern wir können simpel mit einer Suche arbeiten.

Option Explicit
Private Sub CommandButton2_Click()
Dim Treffer As Range
Dim Name As String
Dim freieZeile As Long
Dim wsQuelle As Worksheet, wsZiel As Worksheet
'Set wsQuelle = Workbooks.Open("C:\Datenbank.xlsx").Sheets("Tabelle1")
'//Diesen Teil auskommentieren und daf?r den obigen Teil f?r die Datenbank verwenden
Set wsQuelle = Workbooks("Quelle.xlsx").Sheets("Tabelle1")
'Ab hier sollte nichts ge?ndert werden m?ssen
Set wsZiel = ThisWorkbook.Sheets("Tabelle1")
Name = InputBox("Bitte System-ID eingeben!")
If Name = "" Then Exit Sub
Set Treffer = wsQuelle.UsedRange.Columns("F").Find(Name)
If Not Treffer Is Nothing Then
Treffer.Interior.ColorIndex = 3
With wsZiel
freieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(freieZeile, 1).Value = Treffer.Value
.Cells(freieZeile, 2).Value = Treffer.Offset(0, -3).Value
.Cells(freieZeile, 3).Value = Treffer.Offset(0, -2).Value
.Cells(freieZeile, 4).Value = Treffer.Offset(0, 1).Value
End With
Else
MsgBox "Name nicht vorhanden!"
End If
End Sub

Gruß
Daniel

Beliebteste Forumthreads (12 Monate)

Excel daten kopieren & weitergeben

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel daten kopieren & weitergeben

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread