AW: poste mal den Code o.w.T.
13.01.2005 20:23:15
Reinhard
Hi Harald,
habe mal den Code verändert, (ungetestet).
Gruß
Reinhard
Sub Upgradesales()
Dim store As String, pfad As String, pfad2 As String, datei As String, dateiname As String
Dim soll As String, sollname As String, arg1 As Range, storebud As Double
pfad = "c:\test\"
sollname = "soll.xls"
soll = pfad + sollname
For i = 1 To 167
On Error GoTo 0
If pruef(i) = False Then
k = Right(Str(i), Len(Str(i) - 1))
store = Right("00" + k, 3)
datei = pfad + store + ".xls"
dateiname = store + ".xls"
storebud = store
Application.DisplayAlerts = False
Workbooks.Open datei
Application.DisplayAlerts = True
Sheets("Proj0").Visible = True
Sheets("Proj0").Select
If Val(Range("A16")) <> 2005 And _
MsgBox("Achtung! Falsches Jahr!", vbCritical, (Range("A16") + store)) = vbOK Then Exit For
Range("a16:n19").Copy
Windows("upgrade_sales_proj0_auto.xls").Activate
Sheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False
Workbooks.Open soll, 0, 1
Application.DisplayAlerts = True
Set arg1 = Workbooks(sollname).Sheets("Sheet1").Range("a1:b162")
Windows("upgrade_sales_proj0_auto.xls").Activate
Sheets("Sheet1").Range("N8").Value = WorksheetFunction.VLookup(store, arg1, 2, False)
Range("b20:m21").Copy
Windows(dateiname).Activate
Sheets("Proj0").Range("b17").Select
On Error GoTo sales
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
GoTo fertig
sales:
Windows("upgrade_sales_proj0_auto.xls").Activate
Sheets("Sheet1").Range("b21:m22").Copy
Windows(dateiname).Activate
Sheets("Proj0").Range("b18").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
On Error GoTo 0
fertig:
Windows(dateiname).Close 1
End If
Next i
Application.DisplayAlerts = False
Windows(sollname).Close 0
Application.DisplayAlerts = True
Windows("upgrade_sales_proj0_auto.xls").Activate
Range("a1").Select
End Sub
Function pruef(n As Integer) As Boolean
pruef = False
Select Case n
Case 1, 4, 7, 9, 10, 11, 15, 19, 23, 26, 29, 33, 41, 45, 47, 55, 59, 62, 75, 83, 107, 109, 123, 124, 126, 146, 152, 161, 162, 163, 166
pruef = True
End Select
End Function