habe aus einem früheren Beitrag https://www.herber.de/forum/archiv/1156to1160/1158311_Daten_in_geschlossene_externe_Tabelle_VBA.html#1158472
teilweise das gefunden was ich benötige und es funktioniert auch soweit. Nur hätte ich gern das die übertragenen Daten nicht nur in die externe Datei geschrieben werden, sondern das ganze auch noch nach Datum abgelegt wird.
Es sieht so aus das jeden Tag eine Tabelle mit verschieden Werten erstellt wird. einige dieser Werte müssen für statistiche Zwecke in eine externe Tabelle geschrieben werden. In dem oben genannten Beitrag ist im Code die Zuweisung auf eine bestimmte Zelle bzw. Spalte festgelegt. Ich möchte aber das der zu übertragene Wert dem Datum in der Tabelle zugeorndet wird was vorab bereits in der eigentlichen Tabelle ausgewählt bzw in eine Zelle geschrieben wurde.
Fazit: Berechnungstabelle öffnen. Datum in Zelle B2 eingeben. Berechungen durchführen. diese werden mittels einer Userform, einem Arbeitsplatz zugeordnet der in Spalte A steht zu diesem Arbeitspaltz wird ein Name(Mitarbeiter) ausgewählt die in einer Externen Datei liegen. Diese Namen(Mitarbeiter) sind zusätzlich in Gruppen unterteilt und liegen in 4 verschiedenen Sheets der externen Datei. Alle Daten werden bereits in die selbe Berechnungstabelle mittels der Userform übertragen.
Ich habe bereits hinbekommen das der Name(Mitarbeiter) und ein bestimmter Wert aus der Userform in die geschlossenen externe Datei übertragen werden.
Allerding klappt das mit der gewünschten Zuordnung nach Datum und Gruppe noch nicht so ganz...
Vieleicht kann mir ja jemand weiterhelfen...
Hier der Code meiner Userform
Private Sub UserForm_Initialize()
UserForm1.TextBox1.Value = Worksheets("Schneiden").Range("H19")
UserForm1.TextBox2.Value = Worksheets("Schneiden").Range("I19")
UserForm1.TextBox3.Value = Worksheets("Schneiden").Range("J19")
UserForm1.TextBox4.Value = Worksheets("Schneiden").Range("K19")
UserForm1.TextBox5.Value = Worksheets("Schneiden").Range("L19")
ListBox1.AddItem Range("A18").Value
Dim aRow, i As Long
Application.EnableEvents = False
ComboBox1.Clear
aRow = [A65536].End(xlUp).Row
ComboBox1.AddItem "Bitte Maschine auswählen"
For i = 4 To 16
ComboBox1.AddItem Cells(i, 1) & ", " & Cells(i, 2)
Next i
ComboBox1.ListIndex = 0
Application.EnableEvents = True
Dim sDateiName As String, wbName As Workbook
If Not IsArray(arrName) Then
sDateiName = "X:\Produktivität\AuswertungTestSG1.xls"
Application.ScreenUpdating = True
Application.StatusBar = "Daten werden geladen"
Set wbName = Application.Workbooks.Open(Filename:=sDateiName, ReadOnly:=False)
With Worksheets(1)
arrName = .Range(.Cells(3, 1), .Cells.SpecialCells(xlCellTypeLastCell))
End With
With Worksheets(2)
arrName2 = .Range(.Cells(3, 1), .Cells.SpecialCells(xlCellTypeLastCell))
End With
With Worksheets(3)
arrName3 = .Range(.Cells(3, 1), .Cells.SpecialCells(xlCellTypeLastCell))
End With
With Worksheets(4)
arrName4 = .Range(.Cells(3, 1), .Cells.SpecialCells(xlCellTypeLastCell))
End With
wbName.Close Savechanges:=False
Application.ScreenUpdating = True
Application.StatusBar = False
End If
UserForm1.ComboBox2.List = arrName
UserForm1.ComboBox3.List = arrName2
UserForm1.ComboBox4.List = arrName3
UserForm1.ComboBox5.List = arrName4
Dim yZeile As Long
If ComboBox3.ListIndex = 0 Then
yZeile = ["1"].End(x1Up).Row + 1
Else
xZeile = ComboBox3.ListIndex + 3
End If
UserForm1.ComboBox1.ListIndex = 0
End Sub
Private Sub CommandButton1_Click()
Set Frm = UserForm1
Sheets("Schneiden").Activate
Dim xZeile As Long
If TextBox1 = "" Then Exit Sub
If ComboBox1.ListIndex = 0 Then
xZeile = ["1"].End(x1Up).Row + 1
Else
xZeile = ComboBox1.ListIndex + 3
End If
Cells(xZeile, 2) = ComboBox2.Value
Cells(xZeile, 2) = ComboBox3.Value
Cells(xZeile, 2) = ComboBox4.Value
Cells(xZeile, 2) = ComboBox5.Value
Cells(xZeile, 4) = TextBox1.Value * 1
Cells(xZeile, 6) = TextBox2.Value * 1
Cells(xZeile, 7) = TextBox3.Value * 1
Cells(xZeile, 12) = TextBox4.Value * 1
Cells(xZeile, 23) = TextBox5.Value * 1
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
Dim lastrow As Integer
Dim ws As Worksheet
Dim exapp As New Application
If Range("L4") = ("") Then
End
End If
Set exapp = New Excel.Application 'Neue Excel Instanz eröffnen
exapp.Visible = False 'Excel bleibt unsichtbar
exapp.Workbooks.Open "X:\Produktivität\AuswertungTestSG1.xls" 'Quelldatei öffnen
Set ws = exapp.Worksheets("SG4") 'Quelltabelle angeben...
lastrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
ws.Range("A" & lastrow + 1) = Range("B4").Value
ws.Range("B" & lastrow + 1) = Range("L4").Value
ws.Range("A" & lastrow).Sort Key1:=ws.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set ws = Nothing
exapp.Workbooks("AuswertungTestSG1.xls").Close Savechanges:=True
exapp.Quit
UserForm_Initialize
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Vg Lars