Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopierte Werte in entsprechende Zelle

Kopierte Werte in entsprechende Zelle
11.12.2020 09:36:34
Marco
Hallo zusammen
Ich habe eine Zieldatei mit Kalenderwochen und möchte von anderen Quelldateien die kopierten Werte in der entsprechenden KW einfügen.
Aktuell kriege ich es hin dass ich die Werte aus der einer Quelldatei kopiere und in der Zieldatei in der KW einfüge wenn ich es direkt zu weise.
Wie kann ich zum Beispiel 3 Quelldateien KW49-01/ KW48-01/KW47-01 öffnen?
und dann die gewünschten Werte die Kopiert werden in der Zieldatei in der entsprechenden KW einfügen.
Könnt ihr mir da helfen?
MFG Marco
https://www.herber.de/bbs/user/142249.xlsm
Sub Dateiöffnen()
Set wbZiel = ThisWorkbook.Worksheets("Geplante Zeiten Programm")
Jahr = Right(Year(Cells(44, 26).Value), 2)
KW = Cells(2, 26).Value
Dim FileName As String
'DateiName = S:\Planung20" & Jahr & "\KW" & KW & "-01.xlsm"
Workbooks.Open FileName:=DateiName
Dim Min As String
Dim Max As String
Set wbQuelle = ActiveWorkbook.Worksheets("Wochenplan")
Formel1 = "=min(C:C)"
Formel2 = "=max(C:C)"
Worksheets("Wochenplan").Select
Min = Range("D80")
Max = Range("D81")
Worksheets("Wochenplan").Select 'aktivieren des Arbeitsblattes
Worksheets("Wochenplan").Range("D80").Select
ActiveCell = Formel1 'hier wird in der Zelle Z4 die Formel 1 eingefügt
Worksheets("Wochenplan").Range("D81").Select
ActiveCell = Formel2 'hier wird in der Zelle Z5 die Formel 2 eingefügt
'....aktionen
wbZiel.Range("Z4").Value = wbQuelle.Range("D80") 'wie kriege ich die Kopierten werte in die  _
entsprechende Zelle KW in der Tabelle1?
wbZiel.Range("Z5").Value = wbQuelle.Range("D81") 'wie kriege ich die Kopierten werte in die  _
entsprechende Zelle KW in der Tabelle1?
wbZiel.Range("Z4").NumberFormat = "dd.mm.yyyy hh:mm"
wbZiel.Range("Z5").NumberFormat = "dd.mm.yyyy hh:mm"
Workbooks("KW2-01.xlsm").Close False
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopierte Werte in entsprechende Zelle
11.12.2020 11:36:32
volti
Hallo Marco,
hier mal ein Code, der die gewünschten Werte in die entsprechende Wochenspalte kopiert.
Ich habe jetzt nicht Dein gesamtes Makro angepasst, sondern nur versucht, den Übertragungsteil zu realisieren. Hierbei wird unterstellt, dass im Dateinamen die entsprechende Woche enthalten ist.
Ggf. kannst Du noch einiges aus Deinem "Restcode" rausschmeißen.
Bei Einlesung mehrerer Dateien könnte man z.B. noch eine Schleife drum bauen.
Probiere mal, ob Du damit schon weiterkommst...
Code:
[Cc]

'....aktionen Dim iSpalte As Long, sKW As String 'Daten übertragen On Error Resume Next sKW = Split(wbquelle.Parent.Name, ".")(0) 'Woche aus Dateinamen extrahieren iSpalte = 0 iSpalte = Application.WorksheetFunction.Match(sKW, wbziel.Range("7:7"), 0) If iSpalte > 0 Then With wbziel.Range(wbziel.Cells(4, iSpalte), wbziel.Cells(5, iSpalte)) .Resize(2, 1).Value = wbquelle.Range("D80:D81").Value .NumberFormat = "dd.mm.yyyy hh:mm" End With End If On Error GoTo 0 Workbooks("KW2-01.xlsm").Close False

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige
AW: Kopierte Werte in entsprechende Zelle
11.12.2020 12:43:11
Marco
Hallo Karl-Heinz
Danke dir viel mal für die Hilfe. Funktioniert einwandfrei. Ich hätte eine weitere Frage.
Wie kann ich einbauen dass ab Datum heute die die letzten abgeschlossenen 3KW Quelldateien geöffnet werden und die entsprechenden Daten aus diesen 3 Quelldateien in der Zieldatei in der entsprechenden Woche eingefügt werden? Ist dies überhaupt möglich?
MFG Marco
AW: Kopierte Werte in entsprechende Zelle
11.12.2020 13:31:18
volti
Hallo Marco,
das ist natürlich möglich, ist aber ein bisschen umfangreicher.
Hier fragt man in einer Schleife das Änderungsdatum jeder im betroffenen Pfad abgelegten Datei ab, sortiert diese und öffnet dann halt die neuesten drei Dateien.
Wenn Du etwas Zeit hast, kann ich mich mal daran versuchen.
Es sei denn, Du möchtest es selbst probieren.. 😊
VG KH
Anzeige
AW: Kopierte Werte in entsprechende Zelle
11.12.2020 14:29:17
Marco
Hallo Karl-Heinz
danke dir für die Info.
Das wäre super nett wenn du dies einmal bei Gelegenheit versuchen könntest.
Ich werde ebenfalls versuchen ob ich es hin bekomme und würde dies dann gerne vergleichen, ich möchte ja was lernen und es verstehen und nicht einfach nur deine Lösung kopieren.
MFG Marco
AW: Kopierte Werte in entsprechende Zelle
11.12.2020 16:26:13
volti
Hallo Marco,
Wie kann ich einbauen dass ab Datum heute die die letzten abgeschlossenen 3KW Quelldateien geöffnet werden und die entsprechenden Daten aus diesen 3 Quelldateien in der Zieldatei in der entsprechenden Woche eingefügt werden?.
Mir ist jetzt doch nicht ganz klar, wie genau Du das meinst.
Hier mal eine Anregung, die alle Dateien ab einem bestimmten Datum (z.B. seit gestern Date-1) herausfiltert und abarbeitet.
Da ich keine realen Musterdateien zur Verfügung habe, konnte ich jetzt nicht testen. Aber vielleicht erkennst Du ja meinen Weg...
Ich habe Ermittlung der Dateien und deren Abarbeitung mal getrennt in zwei Schleifen durchgeführt. Geht natürlich auch in einer Schleife.
Code:
[Cc][+][-]

Option Explicit Sub Dateiöffnen() Dim WbZiel As Worksheet, WbQuelle As Worksheet, WKb As Workbook Dim iSpalte As Long, oDatumAb As Date, iAnzDat As Integer, i As Integer Dim sPfad As String, sKW As String, sDatei As String, sDateien() As String Dim oFile As Object, Jahr 'Zielblatt setzen Set WbZiel = ThisWorkbook.Worksheets("Geplante Zeiten Programm") oDatumAb = Date - 1 'Ab Datum setzen Jahr = Right(Year(Cells(44, 26).Value), 2) 'woher? sPfad = "S:\Planung20" & Jahr & "\" 'Datenordner ggf. anpassen 'Ermitteln der relevanten Excelmappen With CreateObject("scripting.filesystemobject").GetFolder(sPfad) For Each oFile In .Files 'Ordner durchsuchen If Err = 0 Then With oFile If .Name Like "*.xls*" Then If FileDateTime(.Path) >= oDatumAb Then ReDim Preserve sDateien(iAnzDat) sDateien(iAnzDat) = sPfad & oFile.Name iAnzDat = iAnzDat + 1 End If End If End With End If Err = 0 Next oFile End With 'Jetzt die gefundenen Dateien öffnen und abarbeiten For i = 0 To iAnzDat Set WKb = Workbooks.Open(FileName:=sDateien(i)) 'Datei öffnen Set WbQuelle = WKb.Worksheets("Wochenplan") 'Formel einfügen erforderlich? With WbQuelle .Range("D80").FormulaLocal = "=min(C:C)" .Range("D81").FormulaLocal = "=max(C:C)" .Calculate End With 'Daten übertragen On Error Resume Next sKW = Split(WKb.Name, ".")(0) 'Woche aus Dateinamen extrahieren iSpalte = 0 iSpalte = Application.WorksheetFunction.Match(sKW, WbZiel.Range("7:7"), 0) If iSpalte > 0 Then With WbZiel.Range(WbZiel.Cells(4, iSpalte), WbZiel.Cells(5, iSpalte)) .Resize(2, 1).Value = WbQuelle.Range("D80:D81").Value .NumberFormat = "dd.mm.yyyy hh:mm" End With End If On Error GoTo 0 WKb.Close False 'Datei schließen Next i End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige