hilfe...
11.08.2013 11:39:37
Frank
Gerd L aus diesem Forum, hat mir bereits geholfen, sodass dieses Makro wie folgt arbeitet. Es gibt eine Kenndaten Tabelle und ein Muster. Pro Reihe der KenndatenTabelle wird ein neues gefülltes Muster erstellt und auf den selben Ordner abgelegt wie die TabellenMappe. Nun Existiert das Problem das pro Reihe nicht immer das selbe Muster gefüllt werden sollen, sondern es immer verschiedene für die Reihe existieren. Das heisst für die jeweilige Reihe soll das zugehörige Muster gefüllt werden(um welches Muster es sich handelt steht ebenfalls in der KenndatenTabelle).
Desweiterin möchte ich das man für einzelne Muster noch festlegt, wie man bestimmte Cellen aus _ der KenndatenTabelle in bestimmte Muster einfügt(das entscheide ich dann selbst)....(nicht wundern die anderen Mustter sind noch nich fertig gestellt)
Sub Schaltfläche2_KlickenSieAuf()
Dim rn As Range
Dim i As Long
Dim ws As Worksheet
Dim wsRM As Worksheet
Dim strDatei As String
Dim btn As Button
Set wsRM = ThisWorkbook.Worksheets("Rechnung")
Set rn = ThisWorkbook.Worksheets("Kenndaten").UsedRange
Application.ScreenUpdating = False
For i = 2 To rn.Rows.Count
strDatei = Dir(ThisWorkbook.Path & "\" & rn.Cells(i, 1).Value & ".xls*")
If strDatei "" Then
Workbooks.Open (ThisWorkbook.Path & "\" & strDatei)
Set ws = ActiveWorkbook.Worksheets(rn.Cells(i, 1).Value)
Else
wsRM.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ws.Name = rn.Cells(i, 1).Value
End If
rn.Rows(i).Columns("$B:$J").Copy
ws.Range("A21").PasteSpecial
Application.CutCopyMode = False
For Each btn In ws.Buttons
btn.Delete
Next btn
If ActiveWorkbook Is ThisWorkbook Then
ws.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xls."
End If
ActiveWorkbook.Close True
Next i
Application.ScreenUpdating = True
Set wsRM = Nothing: Set ws = Nothing: Set rn = Nothing
End Sub
Hier die Datei
https://www.herber.de/bbs/user/86794.xlsm
Hoffe auf Hilfe, Vielen Dank!