Daten übertragen per vba

Question

Hi,

ich habe zwei Dateien, die sich im gleichen Ordner befinden.

Datei 1 = Datenbank mit den Tabellenblättern A-Z
Datei 2 = Auswertung

Wenn die Datei "Auswertung" geöffnet ist soll ein Makro, das per Button gestartet wird, die Daten aus der Datenbank übertragen. Welche Daten ((Tabellenblatt) übertragen sollen, steht in Zelle A10.
Der Bereich der Daten sind auf den jeweiligen Datenbank-Tabellenblätter in A1-D150 und sollen in der Auswertung in A5-D155 eingetragen werden.
Manche Zellen enthalten keine Daten und sollen auch leer bleiben.

Gruß Angelo

Answer 1

«Welche Daten ((Tabellenblatt) übertragen sollen, steht in Zelle A10.»

Soll heißen - du trägst da immer einen Blattnamen (bzw. dessen laufende Nummer ein) und drückst die Taste damit alles aus dem Quellblatt in diesem Blatt mit dem Button landet…
…um nunmehr was zu erreichen?

Ich blicke da nicht so recht durch was passieren soll, und was, wenn man schon ein Makro bemüht, nicht gleich mit erledigt werden könnte. Das hört sich nach einem ›da geht noch viel mehr!‹ an.

Eric March

Answer 2

hi :-)

etwas in der art vielleicht ^^

gruss nighty

Sub DatenLesen()
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Datenbank"
Workbooks("Datenbank").Worksheets("" & ThisWorkbook.Worksheets(1).Range("A1")).Range("A1:A150").Copy _
ThisWorkbook.Worksheets(1).Range("A5")
Workbooks("Datenbank").Close
End Sub

Answer 3

Hi nighty,

vielen Dank für Dine Hilfe. Ich kann nur sagen "Perfekt"

Danke Camillo

Answer 4

hi :-)

wenn es dann passt,ein wenig optimiert ^^

gruss nighty

Sub DateienLesen()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ThisWorkbook.Path & "\" & "Datenbank.xls") = True Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Datenbank"
If SheetExists("" & DeineVariable) = True Then
Workbooks("Datenbank").Worksheets("" & ThisWorkbook.Worksheets(1).Range("A1")).Range("A1:A150").Copy _
ThisWorkbook.Worksheets(1).Range("A5")
Workbooks("Datenbank").Close
Else
MsgBox ("Das benannte Worksheet ist nicht bekannt,bitte um erneute eingabe ?")
Workbooks("Datenbank").Close
End If
Else
MsgBox ("Die Datenbank ist nicht vorhanden ?")
End If
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function

Answer 5

hi :-)

noch fuer interessierte ^^

gruss nighty

on error resume next ist eigentlich frevel *g*

doch in kleinen abgekapselten modulen geduldet *ggg*

Answer 6

hi :-)

eine variable war noch nicht definiert gewesen,wurde korrigiert

gruss nighty

Sub DateienLesen()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ThisWorkbook.Path & "\" & "Datenbank.xls") = True Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Datenbank"
If SheetExists("" & ThisWorkbook.Worksheets(1).Range("A1")) = True Then
Workbooks("Datenbank").Worksheets("" & ThisWorkbook.Worksheets(1).Range("A1")).Range("A1:A150").Copy _
ThisWorkbook.Worksheets(1).Range("A5")
Workbooks("Datenbank").Close
Else
MsgBox ("Das benannte Worksheet ist nicht bekannt,bitte um erneute eingabe ?")
Workbooks("Datenbank").Close
End If
Else
MsgBox ("Die Datenbank ist nicht vorhanden ?")
End If
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function

Answer 7

Hallo nighty,

Gratuliere zu dieser Problemlösung, zumal ich glaube, dass diese Art von Problemstellung nicht einfach zu lösen ist, besonders für mich als VBA-nobody.

schönen Tag noch

Gruß

Paul1