Bestandsdateien öffnen - bearbeiten - kopieren

Hallo zusammen,
ich habe ca. 340 Bestandsdateien aus 2016 und es wird folgendes benötigt - ich hoffe mir kann jemand helfen:
- "Bestandsdatei 01.01.2016" öffnen
- mit Makro bearbeiten (Makro schon vorhanden)würde ich dann gerne einfach in das "Große" Makro einsetzen falls möglich
Folgendes Makro muss dann bei jeder neuen Bestandsdatei ausgeführt werden, bevor es in "Report" kopiert wird:
Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$J$945755").AutoFilter Field:=1, Criteria1:=Array( _
"51", "52", "53", "54", "55", "56", "57", "58", "59", "61", "62", "63", "71"), Operator:= _
xlFilterValues
ActiveSheet.Range("$A$1:$J$945755").AutoFilter Field:=5, Criteria1:=""
ActiveSheet.Range("$A$1:$J$945755").AutoFilter Field:=9, Criteria1:=Array( _
"Anlage", "Fahrrad", "Sperrgut", "="), Operator:=xlFilterValues
Columns("A:I").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
- nach bearbeiten der Bestandsdatei den Inhalt kopieren
- in eine andere Excel kopieren (Dateiname:"Report" -> Sheet: "Warenbestand" Start:B1)
- überstehende Infos unten löschen -> und F9 drücken um alles neu zu berechnen was im Sheet Warenbestand gerechnet werden muss
- Datum im Feld O3 anpassen (Report->Warenbestand)
-nochmals berechnen drücken damit alle Infos in die grünen Sheets gezogen werden (blaue Spalten)
- weiteres Makro ausführen das schon vorhanden ist
dann sind die Zellen hartkopiert -> folgendes Makro:

Public Sub Copy()
Dim rngFund As Range
Dim vaSuchbegriff As Variant
vaSuchbegriff = Sheets("Warenbestand").Range("O3").Value
If Not IsDate(vaSuchbegriff) Then
MsgBox "Bitte ein gültiges Datum eintragen."
Sheets("Warenbestand").Range("O3") = ""
Sheets("Warenbestand").Range("O3").Select
Exit Sub
End If
Set rngFund = Sheets("Übersicht (Angepasst)").Columns(1).Find(vaSuchbegriff, LookIn:=xlValues,  _
Lookat:= _
xlPart)
If Not rngFund Is Nothing Then
With Sheets("Übersicht (Angepasst)")
.Range(.Cells(rngFund.Row, 40), .Cells(rngFund.Row, 52)).Value = _
.Range(.Cells(rngFund.Row, 40), .Cells(rngFund.Row, 52)).Value
.Cells(rngFund.Row, 61).Value = .Cells(rngFund.Row, 61).Value
.Range(.Cells(rngFund.Row, 65), .Cells(rngFund.Row, 68)).Value = _
.Range(.Cells(rngFund.Row, 65), .Cells(rngFund.Row, 68)).Value
.Range(.Cells(rngFund.Row, 76), .Cells(rngFund.Row, 79)).Value = _
.Range(.Cells(rngFund.Row, 76), .Cells(rngFund.Row, 79)).Value
.Cells(rngFund.Row, 88).Value = .Cells(rngFund.Row, 88).Value
End With
Else
MsgBox "Das Datum " & vaSuchbegriff & " wurde" & vbLf & _
" in Blatt 2 nicht gefunden."
Sheets("Warenbestand").Range("O3") = ""
Sheets("Warenbestand").Range("O3").Select
End If
Set rngFund = Sheets("Bestand - nach Lagerort").Columns(1).Find(vaSuchbegriff, LookIn:=xlValues, _
Lookat:= _
xlPart)
If Not rngFund Is Nothing Then
With Sheets("Bestand - nach Lagerort")
.Range(.Cells(rngFund.Row, 3), .Cells(rngFund.Row, 6)).Value = _
.Range(.Cells(rngFund.Row, 3), .Cells(rngFund.Row, 6)).Value
.Range(.Cells(rngFund.Row, 8), .Cells(rngFund.Row, 11)).Value = _
.Range(.Cells(rngFund.Row, 8), .Cells(rngFund.Row, 11)).Value
.Range(.Cells(rngFund.Row, 13), .Cells(rngFund.Row, 16)).Value = _
.Range(.Cells(rngFund.Row, 13), .Cells(rngFund.Row, 16)).Value
.Range(.Cells(rngFund.Row, 20), .Cells(rngFund.Row, 23)).Value = _
.Range(.Cells(rngFund.Row, 20), .Cells(rngFund.Row, 23)).Value
.Range(.Cells(rngFund.Row, 25), .Cells(rngFund.Row, 28)).Value = _
.Range(.Cells(rngFund.Row, 25), .Cells(rngFund.Row, 28)).Value
.Range(.Cells(rngFund.Row, 30), .Cells(rngFund.Row, 33)).Value = _
.Range(.Cells(rngFund.Row, 30), .Cells(rngFund.Row, 33)).Value
.Range(.Cells(rngFund.Row, 37), .Cells(rngFund.Row, 40)).Value = _
.Range(.Cells(rngFund.Row, 37), .Cells(rngFund.Row, 40)).Value
.Range(.Cells(rngFund.Row, 42), .Cells(rngFund.Row, 45)).Value = _
.Range(.Cells(rngFund.Row, 42), .Cells(rngFund.Row, 45)).Value
.Range(.Cells(rngFund.Row, 47), .Cells(rngFund.Row, 50)).Value = _
.Range(.Cells(rngFund.Row, 47), .Cells(rngFund.Row, 50)).Value
.Range(.Cells(rngFund.Row, 52), .Cells(rngFund.Row, 57)).Value = _
.Range(.Cells(rngFund.Row, 52), .Cells(rngFund.Row, 57)).Value
.Range(.Cells(rngFund.Row, 59), .Cells(rngFund.Row, 62)).Value = _
.Range(.Cells(rngFund.Row, 59), .Cells(rngFund.Row, 62)).Value
.Range(.Cells(rngFund.Row, 64), .Cells(rngFund.Row, 67)).Value = _
.Range(.Cells(rngFund.Row, 64), .Cells(rngFund.Row, 67)).Value
.Range(.Cells(rngFund.Row, 71), .Cells(rngFund.Row, 74)).Value = _
.Range(.Cells(rngFund.Row, 71), .Cells(rngFund.Row, 74)).Value
.Range(.Cells(rngFund.Row, 76), .Cells(rngFund.Row, 79)).Value = _
.Range(.Cells(rngFund.Row, 76), .Cells(rngFund.Row, 79)).Value
.Range(.Cells(rngFund.Row, 81), .Cells(rngFund.Row, 84)).Value = _
.Range(.Cells(rngFund.Row, 81), .Cells(rngFund.Row, 84)).Value
.Range(.Cells(rngFund.Row, 88), .Cells(rngFund.Row, 91)).Value = _
.Range(.Cells(rngFund.Row, 88), .Cells(rngFund.Row, 91)).Value
.Range(.Cells(rngFund.Row, 93), .Cells(rngFund.Row, 96)).Value = _
.Range(.Cells(rngFund.Row, 93), .Cells(rngFund.Row, 96)).Value
.Range(.Cells(rngFund.Row, 98), .Cells(rngFund.Row, 101)).Value = _
.Range(.Cells(rngFund.Row, 98), .Cells(rngFund.Row, 101)).Value
.Range(.Cells(rngFund.Row, 105), .Cells(rngFund.Row, 108)).Value = _
.Range(.Cells(rngFund.Row, 105), .Cells(rngFund.Row, 108)).Value
.Range(.Cells(rngFund.Row, 110), .Cells(rngFund.Row, 113)).Value = _
.Range(.Cells(rngFund.Row, 110), .Cells(rngFund.Row, 113)).Value
.Range(.Cells(rngFund.Row, 115), .Cells(rngFund.Row, 118)).Value = _
.Range(.Cells(rngFund.Row, 115), .Cells(rngFund.Row, 118)).Value
.Range(.Cells(rngFund.Row, 122), .Cells(rngFund.Row, 125)).Value = _
.Range(.Cells(rngFund.Row, 122), .Cells(rngFund.Row, 125)).Value
.Range(.Cells(rngFund.Row, 127), .Cells(rngFund.Row, 130)).Value = _
.Range(.Cells(rngFund.Row, 127), .Cells(rngFund.Row, 130)).Value
.Range(.Cells(rngFund.Row, 132), .Cells(rngFund.Row, 135)).Value = _
.Range(.Cells(rngFund.Row, 132), .Cells(rngFund.Row, 135)).Value
.Range(.Cells(rngFund.Row, 139), .Cells(rngFund.Row, 142)).Value = _
.Range(.Cells(rngFund.Row, 139), .Cells(rngFund.Row, 142)).Value
.Range(.Cells(rngFund.Row, 144), .Cells(rngFund.Row, 147)).Value = _
.Range(.Cells(rngFund.Row, 144), .Cells(rngFund.Row, 147)).Value
.Range(.Cells(rngFund.Row, 149), .Cells(rngFund.Row, 152)).Value = _
.Range(.Cells(rngFund.Row, 149), .Cells(rngFund.Row, 152)).Value
.Range(.Cells(rngFund.Row, 168), .Cells(rngFund.Row, 170)).Value = _
.Range(.Cells(rngFund.Row, 168), .Cells(rngFund.Row, 170)).Value
.Range(.Cells(rngFund.Row, 173), .Cells(rngFund.Row, 175)).Value = _
.Range(.Cells(rngFund.Row, 173), .Cells(rngFund.Row, 175)).Value
.Range(.Cells(rngFund.Row, 178), .Cells(rngFund.Row, 180)).Value = _
.Range(.Cells(rngFund.Row, 178), .Cells(rngFund.Row, 180)).Value
.Range(.Cells(rngFund.Row, 189), .Cells(rngFund.Row, 191)).Value = _
.Range(.Cells(rngFund.Row, 189), .Cells(rngFund.Row, 191)).Value
.Range(.Cells(rngFund.Row, 194), .Cells(rngFund.Row, 194)).Value = _
.Range(.Cells(rngFund.Row, 194), .Cells(rngFund.Row, 194)).Value
End With
Else
MsgBox "Das Datum " & vaSuchbegriff & " wurde" & vbLf & _
" in Blatt 3 nicht gefunden."
Sheets("Warenbestand").Range("O3") = ""
Sheets("Warenbestand").Range("O3").Select
End If
End Sub

Daraufhin muss das ganze mit der Datei 02.01.2016 passieren und das alles automatisch
Bedeutet: das Makro zum Bestandsdatei bearbeiten ist schon vorhanden
und das Makro um alle "blauen" Felder in den Grünen Sheets in der Datei Report hart zu kopieren ist ebenfalls vorhanden
was fehlt ist ein Makro welches sich die Dateien automatisch aus einem Ordner zieht, die Bestandsdatei Bearbeitungsmakro ausführt -> dann das kopiert in "Report->Warenbestand B1" dann das Datum erkennt (kann ich einfügen je nach dem wo es am einfachsten ist - hier baue ich auf eure Meinung) und dann das "hartkopieren" makro laufen lässt..
das ganze dann mit mehreren Dateien aus dem ganzen Jahr
Dateinamen kann ich manuell festlegen und auch ein Datum in die Bestandsdatei oder sonst wo kann ich eintragen.
Könnt ihr mir hier helfen? Ich habe mal zwei Bestandsdateien angehängt und auch den Report angehängt.
Dateien können hier runtergalden werden leider war die eine zu groß für das Forum hier:
http://www.file-upload.net/download-12170815/Report.xlsm.html
http://www.file-upload.net/download-12170814/Bestandsdatei01.01.2016.xlsx.html
http://www.file-upload.net/download-12170813/Bestandsdatei02.01.2016.xlsx.html

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

etwas umfangreich

16.12.2016 17:50:55

Michael

Sub t1() Dim tag& ' & = as long Const PfadDatei = "C:\A_Forum_DL\CodeAnalyse_" ' hier eben alles, was links vom Datum stehen soll Dim DateiZumEinlesen$ ' $ = as string For tag = 42370 To 42372 ' 42735 wäre dann der 31.12.2016 DateiZumEinlesen = PfadDatei & Format(tag, "DD.MM.YYYY") & ".xlsx" If Dir(DateiZumEinlesen) "" Then MsgBox "Datei gefunden, hier Code einfügen" Else MsgBox "Datei nicht gefunden, hier evtl. weiterer Code" ' z.B. ein extra Tabellenblatt, in dem alle Dateinamen ' in einer Spalte und "ok" bzw. "nv" in einer weiteren ' ausgegeben wird End If Next End Sub

Sub t() Dim s$, sarr Dim z As Long, i As Long z = 5 ' bzw. dann Dein rngFund.Row Const sVorlage = "C:F,H:K,M:P,T:W,Y:AB,AD:AG,AK:AN,AP:AS,AU:AX,AZ:BE," & _ "BG:BJ,BL:BO,BS:BV,BX:CA,CC:CF,CJ:CM,CO:CR,CT:CW,DA:DD,DF:DI,DK:DN," & _ "DR:DU,DW:DZ,EB:EE,EI:EL,EN:EQ,ES:EV,FL:FN,FQ:FS,FV:FX,GG:GI,GL," s = Replace(sVorlage, ",", z & ",") s = Replace(s, ":", z & ":") s = Left(s, Len(s) - 1) ' Debug.Print s 'With Range(s) ' .Interior.Color = vbYellow ' .Value = .Value ' das geht leider nicht "richtig" 'End With sarr = Split(s, ",") With Sheets("Tabelle1") For i = 0 To UBound(sarr) .Range(sarr(i)).Value = Range(sarr(i)).Value .Range(sarr(i)).Interior.Color = vbGreen Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Bestandsdateien öffnen - bearbeiten - kopieren

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

38 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bestandsdateien öffnen - bearbeiten - kopieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

38 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread