Daten aus anderer Datei

Haqllo Excel-Freunde
Habe wieder einmal ein Problem bei dem ich trotz langer Suche noch keine Lösung gefunden Habe:
In der Datei "FF 2011 KW 38" steht auf Tabelle 1 in Zelle E1 die aktuelle KW(aktuell KW "38").
Diese Zelle wird weiterverarbeitetund weist in anderen Zellen das Datum und die Wochentage aus.
Nun soll in Zelle BH5 der Wert aus der Datei "FF 2011 KW 37" Tabelle 1 Zelle BB5 stehen.
Die Dateien sind unter C/Aldi/2011/FF-Bestellung 2011 gespeichert.
ACHTUNG:
SIEHE UNTER WICHTIG(unten)

Das ganze soll später noch erweitert werden, so das Daten für die Zellen BH5 bis BY75 übernommen werden.
In Zelle BH5 bis BM75 sollen dann die Daten aus Datei "FF 2011 KW 37", in Zelle BN5 - BS75 die Daten aus Datei "FF 2011 KW 36", in Zelle BT5 - BY75 die Daten aus Datei FF 2011 KW 35".
WICHTIG
wenn in Zelle E1 die nächste Woche steht (z.Bsp. 39), dann sollen die Daten aus Datei "FF 2011 KW 38", "FF 2011 KW 37", "FF 2011 KW 36" übernommen werden.
Also immer die Daten der 3 Wochen vorher.
Vielen Dank im voraus
Gruß
Werner
PS bin jetzt ca. 3 Std. erst mal weg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Daten_letzte_3_Wochen() Dim sPfad As String, sDatei As String, sJahr As String Dim sKW As String, iKW As Integer Dim wksZiel As Worksheet Dim wbQuelle As Workbook, wksQuelle As Worksheet sJahr = "2011" sPfad = "C:\Aldi\" & sJahr & "\FF-Bestellung " & sJahr Set wksZiel = ActiveWorkbook.Worksheets(1) iKW = wksZiel.Range("E1").Value - 1 'KW der Vorwoche sKW = Format(iKW, "00") 'ggf. "00" ändern in "0" wenn KW 1 bis 9 ohne führende 0 sDatei = "FF " & sJahr & " KW " & sKW With wksZiel 'Prüfen ob Quelldatei (datei der Vorwoche) vorhanden sDatei = Dir(sPfad & "\" & sDatei & ".xls*") If sDatei "" Then 'Daten der letzten 2 Wochen verschieben/kopieren .Range("BH5:BS75").Copy Destination:=.Range("BN5") 'Datei der Vorwoche schreibgeschützt öffnen Set wbQuelle = Workbooks.Open(Filename:=sPfad & "\" & sDatei, ReadOnly:=True) Set wksQuelle = wbQuelle.Worksheets(1) wksQuelle.Range("BB5:BG75").Copy wksZiel.Range("BH5").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False wbQuelle.Close savechanges:=False Set wbQuelle = Nothing Set wksQuelle = Nothing Else MsgBox "Datei der Vorwoche (KW " & sKW & ") ist nicht vorhanden", _ vbInformation, "Daten der Vorwoche holen" End If End With Set wksZiel = Nothing End Sub

Hallo Werner,
ich hab mir jetzt die Mühe gemacht, entsprechende Testdateien für die KWs anzulegen.
Der Makroablauf funktioniert.
Dabei müssen dann die Daten aus den Vorwochen im Bereich BH5:BM75 bzw. BN5:BS75 noch vorhanden sein.
Ich hab das Makro jetzt umgestellt. Es werden immer die 3 Dateien der Vorwochen geöffnet und die Werte an die entsprechende Positon kopiert.
Gruß
Franz


Sub Daten_letzte_3_Wochen_Var01()
Dim sPfad As String, sDatei As String, sJahr As String
Dim sKW As String, iKW As Integer, lngOffset As Long
Dim wksZiel As Worksheet
Dim wbQuelle As Workbook, wksQuelle As Worksheet
sJahr = "2011"
sPfad = "C:\Aldi\" & sJahr & "\FF-Bestellung " & sJahr
Set wksZiel = ActiveWorkbook.Worksheets(1)
With wksZiel
'Daten im Bereich der letzten 3 Wochen löschen
.Range("BH5:BY75").ClearContents
iKW = .Range("E1").Value ' aktuelle KW
lngOffset = 0
Application.ScreenUpdating = False
For iKW = iKW - 1 To iKW - 3 Step -1
sKW = Format(iKW, "00") 'ggf. "00" ändern in "0" wenn KW 1 bis 9 ohne führende 0
sDatei = "FF " & sJahr & " KW " & sKW
'Prüfen ob Quelldatei vorhanden
sDatei = Dir(sPfad & "\" & sDatei & ".xls*")
If sDatei  "" Then
'Datei der Vorwoche schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open(Filename:=sPfad & "\" & sDatei, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1)
wksQuelle.Range("BB5:BG75").Copy
wksZiel.Range("BH5").Offset(0, lngOffset).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wbQuelle.Close savechanges:=False
Set wbQuelle = Nothing
Set wksQuelle = Nothing
Else
MsgBox "Datei der Woche (KW " & sKW & ") ist nicht vorhanden", _
vbInformation, "Daten der Vorwochen holen"
End If
lngOffset = lngOffset + 6
Next
Range("BH5").Select
Application.ScreenUpdating = False
End With
Set wksZiel = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus anderer Datei

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

329 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread