Hi,
leider weis ich nicht mehr, wo bzw. in welche Stelle ich den Code verbessern kann. Ich hoffe du kannst mir genau die Stellen zeigen, wo eine Verbesserung nötig ist, um den Code zu verbessern. Wenn Du mir auch zeigen würdest, wie dann währe ich dir Dankbar. Anbei erhaltest Du, die komplette Code:
Sub InbestimmtenOrdnerspeicher()
'VBA bzw. Makroausführung im Hintergrund
Application.ScreenUpdating = False
' Rechnung im Rechnungsjournal buchen
' hier wird in der Zeile 50 und Spalte 5 nach Zelle geschaut, wenn es leer ist dann wird der Prozedur einfach beendet
If Sheets("Rechnung").Cells(70, 12) = 0 Then
MsgBox ("Sie haben keine Artikel ausgewählt. Bitte gewünschte Artikel eigeben!")
Exit Sub
End If
' Arbeitsmappen werden ungeschützt geöffnet
ActiveSheet.Unprotect ("test")
Worksheets("Kunden").Visible = True
Worksheets("Forderungen").Visible = True
Worksheets("Einnahmen Übersicht").Visible = True
Worksheets("Journal Gutschrift Übersicht").Visible = True
Worksheets("Personal").Visible = True
Worksheets("Artikel").Visible = True
Worksheets("Kundenpreise").Visible = True
Worksheets("Infos f YH").Visible = True
Worksheets("Journal").Visible = True
Worksheets("Lieferart").Visible = True
Worksheets("Verkaufte Artikel").Visible = True
Worksheets("Verkaufte Artikel-Normal").Visible = True
Worksheets("Pfand Kosten").Visible = True
Sheets("ST Verkaufte Artikel Gesamt").Visible = True
Sheets("ST Pfand Kosten").Visible = True
Worksheets("Gutschrift").Visible = True
Worksheets("Journal Gutschrift").Visible = True
'Arbeitsmappe Rechnung wird ausgewählt
Sheets("Rechnung").Select
[j19] = [j19] + 1
Cells(18, 10).Value = Format(Date, "dd.mm.yy")
Dim sPath As String
Dim Speicherpfad As String
Dim SpeicherpfadDatei As String
Dim Kundenname As String
Kundenname = Range("E18").Value
SpeicherpfadDatei = Range("e4").Value
Speicherpfad = Range("j15").Value
dat = Range("J18").Value
sPath = "D:\Touren\Faktura\" & Speicherpfad & "\"
On Error Resume Next
MkDir sPath & Year(dat)
sPath = sPath & Year(dat) & "\"
MkDir sPath & Kundenname
sPath = sPath & Kundenname & "\"
MkDir sPath & Format(dat, "mm yyyy")
sPath = sPath & Format(dat, "mm yyyy") & "\"
ActiveSheet.Copy
ActiveWorkbook.SaveAs sPath & _
Range("j19").Value & " " & Range("J15") & " " & Range("E18") & _
" " & Format(dat, " dd-mm-yyyy") & ".xls"
ActiveWorkbook.Close
For x = 26 To 55
'1. Range("E" & x).Select
'1. Artikelname$ = ActiveCell.Value
Artikelname$ = Range("E" & x).Value '1. wurde ersetzt
'2. Range("d" & x).Select
'2. Menge = ActiveCell.Value
Menge$ = Range("D" & x).Value '2. wurde ersetzt
'Range("E" & x).Select
Sheets("artikel").Select
Range("B9").Select
'vermeide das ganze "hin-und her-"selektieren.
' Ersetze z.B.
' Range("E" & x).Select
' Artikelname$ = ActiveCell.Value
' durch
' Artikelname$ = Range("E" & x).Value
For a = 10 To ActiveCell.SpecialCells(xlLastCell).Row + 1
'Range("B" & A).Select
Artikelname1$ = ActiveCell.Value
Range("B" & a).Select
If Artikelname1$ = Artikelname$ Then
Range("H" & a).Select
Bestand = Range("H" & a).Value - Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next a
Sheets("Rechnung").Select
Range("E" & x).Select
Next x
For y = 64 To 69
'Range("E" & y).Select
'Artikelname$ = ActiveCell.Value
Artikelname$ = ActiveCell.Value
Range("E" & x).Select
'Range("d" & y).Select
Menge = Range("d" & y).Value
Range("E" & y).Select
Sheets("artikel").Select
Range("B9").Select
For B = 11 To ActiveCell.SpecialCells(xlLastCell).Row + 1
Range("B" & B).Select
Artikelname1$ = ActiveCell.Value
If Artikelname1$ = Artikelname$ Then
Range("K" & B).Select
Bestand = ActiveCell.Value + Menge
ActiveCell.Value = Bestand
Range("B" & a).Select
Exit For
End If
Next B
Sheets("Rechnung").Select
Range("E" & x).Select
Next y
Sheets("Journal").Select 'Übertragung v. Rechnung nach Journal
Range("A:A").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5) ' Kunden Name
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Rechnung").Cells(19, 10) ' RechngNr
ActiveCell.Offset(0, 5) = Sheets("Rechnung").Cells(18, 10) ' RechndDatum
ActiveCell.Offset(0, 6) = Sheets("Rechnung").Cells(61, 5) 'MWSt 7%
ActiveCell.Offset(0, 7) = Sheets("Rechnung").Cells(61, 7) ' MWSt 16%
ActiveCell.Offset(0, 8) = Sheets("Rechnung").Cells(61, 10) 'MWSt Gesamt
ActiveCell.Offset(0, 9) = Sheets("Rechnung").Cells(70, 12) 'Zahlbetrag
ActiveCell.Offset(0, 10) = Sheets("Rechnung").Cells(64, 11) 'Bezahle Betrag
ActiveCell.Offset(0, 11) = Sheets("Rechnung").Cells(65, 11) 'Offene Betrag
ActiveCell.Offset(0, 12) = Sheets("Rechnung").Cells(62, 12) 'Pfand Bezahlt
ActiveCell.Offset(0, 13) = Sheets("Rechnung").Cells(70, 10) 'Pfand Rückgabe
ActiveCell.Offset(0, 14) = Sheets("Rechnung").Cells(64, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 15) = Sheets("Rechnung").Cells(64, 5) 'Pfand Artikel
ActiveCell.Offset(0, 16) = Sheets("Rechnung").Cells(65, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 17) = Sheets("Rechnung").Cells(65, 5) 'Pfand Artikel
ActiveCell.Offset(0, 18) = Sheets("Rechnung").Cells(66, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 19) = Sheets("Rechnung").Cells(66, 5) 'Pfand Artikel
ActiveCell.Offset(0, 20) = Sheets("Rechnung").Cells(67, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 21) = Sheets("Rechnung").Cells(67, 5) 'Pfand Artikel
ActiveCell.Offset(0, 22) = Sheets("Rechnung").Cells(68, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 23) = Sheets("Rechnung").Cells(68, 5) 'Pfand Artikel
ActiveCell.Offset(0, 24) = Sheets("Rechnung").Cells(69, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 25) = Sheets("Rechnung").Cells(69, 5) 'Pfand Artikel
Sheets("Verkaufte Artikel-Normal").Select 'Übertragung v. Rechnung n. Verk. Artikel
ActiveSheet.Unprotect ("test")
Range("A:A").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5) ' Kundenname
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Rechnung").Cells(19, 10) ' RechndNr
ActiveCell.Offset(0, 5) = Sheets("Rechnung").Cells(18, 10) ' RechngDatum
ActiveCell.Offset(0, 6) = Sheets("Rechnung").Cells(26, 4) 'Anzahl
ActiveCell.Offset(0, 7) = Sheets("Rechnung").Cells(26, 5) 'Beschreibung
ActiveCell.Offset(0, 8) = Sheets("Rechnung").Cells(27, 4) 'Anzahl
ActiveCell.Offset(0, 9) = Sheets("Rechnung").Cells(27, 5) 'Beschreibung
ActiveCell.Offset(0, 10) = Sheets("Rechnung").Cells(28, 4) 'Anzal
ActiveCell.Offset(0, 11) = Sheets("Rechnung").Cells(28, 5) 'Beschreibung
ActiveCell.Offset(0, 12) = Sheets("Rechnung").Cells(29, 4) 'Anzal
ActiveCell.Offset(0, 13) = Sheets("Rechnung").Cells(29, 5) 'Beschreibung
ActiveCell.Offset(0, 14) = Sheets("Rechnung").Cells(30, 4) 'Anzal
ActiveCell.Offset(0, 15) = Sheets("Rechnung").Cells(30, 5) 'Beschreibung
ActiveCell.Offset(0, 16) = Sheets("Rechnung").Cells(31, 4) 'Anzal
ActiveCell.Offset(0, 17) = Sheets("Rechnung").Cells(31, 5) 'Beschreibung
ActiveCell.Offset(0, 18) = Sheets("Rechnung").Cells(32, 4) 'Anzal
ActiveCell.Offset(0, 19) = Sheets("Rechnung").Cells(32, 5) 'Beschreibung
ActiveCell.Offset(0, 20) = Sheets("Rechnung").Cells(33, 4) 'Anzal
ActiveCell.Offset(0, 21) = Sheets("Rechnung").Cells(33, 5) 'Beschreibung
ActiveCell.Offset(0, 22) = Sheets("Rechnung").Cells(34, 4) 'Anzal
ActiveCell.Offset(0, 23) = Sheets("Rechnung").Cells(34, 5) 'Beschreibung
ActiveCell.Offset(0, 24) = Sheets("Rechnung").Cells(35, 4) 'Anzal
ActiveCell.Offset(0, 25) = Sheets("Rechnung").Cells(35, 5) 'Beschreibung
ActiveCell.Offset(0, 26) = Sheets("Rechnung").Cells(36, 4) 'Anzal
ActiveCell.Offset(0, 27) = Sheets("Rechnung").Cells(36, 5) 'Beschreibung
ActiveCell.Offset(0, 28) = Sheets("Rechnung").Cells(37, 4) 'Anzal
ActiveCell.Offset(0, 29) = Sheets("Rechnung").Cells(37, 5) 'Beschreibung
ActiveCell.Offset(0, 30) = Sheets("Rechnung").Cells(38, 4) 'Anzal
ActiveCell.Offset(0, 31) = Sheets("Rechnung").Cells(38, 5) 'Beschreibung
ActiveCell.Offset(0, 32) = Sheets("Rechnung").Cells(39, 4) 'Anzal
ActiveCell.Offset(0, 33) = Sheets("Rechnung").Cells(39, 5) 'Beschreibung
ActiveCell.Offset(0, 34) = Sheets("Rechnung").Cells(40, 4) 'Anzal
ActiveCell.Offset(0, 35) = Sheets("Rechnung").Cells(40, 5) 'Beschreibung
ActiveCell.Offset(0, 36) = Sheets("Rechnung").Cells(41, 4) 'Anzal
ActiveCell.Offset(0, 37) = Sheets("Rechnung").Cells(41, 5) 'Besch
ActiveCell.Offset(0, 38) = Sheets("Rechnung").Cells(42, 4) 'Anzal
ActiveCell.Offset(0, 39) = Sheets("Rechnung").Cells(42, 5) 'Beschreibung
ActiveCell.Offset(0, 40) = Sheets("Rechnung").Cells(43, 4) 'Anzal 18-24
ActiveCell.Offset(0, 41) = Sheets("Rechnung").Cells(43, 5) 'Beschreibung
ActiveCell.Offset(0, 42) = Sheets("Rechnung").Cells(44, 4) 'Anzal 19-24
ActiveCell.Offset(0, 43) = Sheets("Rechnung").Cells(44, 5) 'Beschreibung
ActiveCell.Offset(0, 44) = Sheets("Rechnung").Cells(45, 4) 'Anzal 20-24
ActiveCell.Offset(0, 45) = Sheets("Rechnung").Cells(45, 5) 'Beschreibung
ActiveCell.Offset(0, 46) = Sheets("Rechnung").Cells(46, 4) 'Anzal 21-24
ActiveCell.Offset(0, 47) = Sheets("Rechnung").Cells(46, 5) 'Beschreibung
ActiveCell.Offset(0, 48) = Sheets("Rechnung").Cells(47, 4) 'Anzal 22-24
ActiveCell.Offset(0, 49) = Sheets("Rechnung").Cells(47, 5) 'Beschreibung
ActiveCell.Offset(0, 50) = Sheets("Rechnung").Cells(48, 4) 'Anzal 23-24
ActiveCell.Offset(0, 51) = Sheets("Rechnung").Cells(48, 5) 'Beschreibung
ActiveCell.Offset(0, 52) = Sheets("Rechnung").Cells(49, 4) 'Anzal 24-24
ActiveCell.Offset(0, 53) = Sheets("Rechnung").Cells(49, 5) 'Beschreibung
ActiveCell.Offset(0, 54) = Sheets("Rechnung").Cells(50, 4) 'Anzal 25-30
ActiveCell.Offset(0, 55) = Sheets("Rechnung").Cells(50, 5) 'Beschreibung
ActiveCell.Offset(0, 56) = Sheets("Rechnung").Cells(51, 4) 'Anzal 26-30
ActiveCell.Offset(0, 57) = Sheets("Rechnung").Cells(51, 5) 'Beschreibung
ActiveCell.Offset(0, 58) = Sheets("Rechnung").Cells(52, 4) 'Anzal 27-30
ActiveCell.Offset(0, 59) = Sheets("Rechnung").Cells(52, 5) 'Beschreibung
ActiveCell.Offset(0, 60) = Sheets("Rechnung").Cells(53, 4) 'Anzal 28-30
ActiveCell.Offset(0, 61) = Sheets("Rechnung").Cells(53, 5) 'Beschreibung
ActiveCell.Offset(0, 62) = Sheets("Rechnung").Cells(54, 4) 'Anzal 29-30
ActiveCell.Offset(0, 63) = Sheets("Rechnung").Cells(54, 5) 'Beschreibung
Dim lgErg As Long
Dim wksArt As Worksheet
Dim wksRe As Worksheet
Dim wksGu As Worksheet
Dim intRe As Integer
Dim intGu As Integer
Set wksArt = Sheets("Artikel")
Set wksRe = Sheets("Rechnung")
Set wksGu = Sheets("Gutschrift")
intRe = 26
intGu = 26
Do Until intRe > 55 Or IsEmpty(wksRe.Cells(intRe, 5))
lgErg = WorksheetFunction.Match(wksRe.Cells(intRe, 5), Sheets("Artikel").Range("B10:B53"), 0)
If wksArt.Cells(lgErg + 9, 3) = "Getränke Pfand" Then
wksGu.Cells(intGu, 7) = wksRe.Cells(intRe, 5)
wksGu.Cells(intGu, 4) = wksRe.Cells(intRe, 4)
intGu = intGu + 1
End If
intRe = intRe + 1
Loop
Sheets("Gutschrift").Select
Zahl = Cells(59, 12)
Select Case Zahl
Case Is > 0
Sheets("Gutschrift").Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=0, Collate:=True
End Select
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Journal Gutschrift").Select 'Übertrag v. Rechnung n. Journal Gutsch.
Range("A:A").Select
'Selection.SpecialCells(xlBlanks).Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Sheets("Rechnung").Cells(18, 5) ' Kunden Name
ActiveCell.Offset(0, 1) = Sheets("Rechnung").Cells(4, 5) ' Tourname
ActiveCell.Offset(0, 2) = Sheets("Rechnung").Cells(15, 10) ' Faktura-Art
ActiveCell.Offset(0, 3) = Sheets("Rechnung").Cells(20, 10) ' Personal-Name
ActiveCell.Offset(0, 4) = Sheets("Gutschrift").Cells(19, 10) ' RechngNr
ActiveCell.Offset(0, 5) = Sheets("Gutschrift").Cells(18, 10) ' RechndDatum
ActiveCell.Offset(0, 6) = Sheets("Gutschrift").Cells(61, 5) 'MWSt 7%
ActiveCell.Offset(0, 7) = Sheets("Gutschrift").Cells(61, 7) ' MWSt 16%
ActiveCell.Offset(0, 8) = Sheets("Gutschrift").Cells(61, 10) 'MWSt Gesamt
ActiveCell.Offset(0, 9) = Sheets("Gutschrift").Cells(70, 12) 'Zahlbetrag
ActiveCell.Offset(0, 10) = Sheets("Gutschrift").Cells(64, 11) 'Bezahle Betrag
ActiveCell.Offset(0, 11) = Sheets("Gutschrift").Cells(65, 11) 'Offene Betrag
ActiveCell.Offset(0, 12) = Sheets("Gutschrift").Cells(62, 12) 'Pfand Bezahlt
ActiveCell.Offset(0, 13) = Sheets("Gutschrift").Cells(70, 10) 'Pfand Rückgabe
ActiveCell.Offset(0, 14) = Sheets("Gutschrift").Cells(64, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 15) = Sheets("Gutschrift").Cells(64, 5) 'Pfand Artikel
ActiveCell.Offset(0, 16) = Sheets("Gutschrift").Cells(65, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 17) = Sheets("Gutschrift").Cells(65, 5) 'Pfand Artikel
ActiveCell.Offset(0, 18) = Sheets("Gutschrift").Cells(66, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 19) = Sheets("Gutschrift").Cells(66, 5) 'Pfand Artikel
ActiveCell.Offset(0, 20) = Sheets("Gutschrift").Cells(67, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 21) = Sheets("Gutschrift").Cells(67, 5) 'Pfand Artikel
ActiveCell.Offset(0, 22) = Sheets("Gutschrift").Cells(68, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 23) = Sheets("Gutschrift").Cells(68, 5) 'Pfand Artikel
ActiveCell.Offset(0, 24) = Sheets("Gutschrift").Cells(69, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 25) = Sheets("Gutschrift").Cells(69, 5) 'Pfand Artikel
ActiveCell.Offset(0, 26) = Sheets("Gutschrift").Cells(70, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 27) = Sheets("Gutschrift").Cells(71, 5) 'Pfand Artikel
ActiveCell.Offset(0, 28) = Sheets("Gutschrift").Cells(72, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 29) = Sheets("Gutschrift").Cells(73, 5) 'Pfand Artikel
ActiveCell.Offset(0, 30) = Sheets("Gutschrift").Cells(74, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 31) = Sheets("Gutschrift").Cells(75, 5) 'Pfand Artikel
ActiveCell.Offset(0, 32) = Sheets("Gutschrift").Cells(76, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 33) = Sheets("Gutschrift").Cells(77, 5) 'Pfand Artikel
ActiveCell.Offset(0, 34) = Sheets("Gutschrift").Cells(78, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 35) = Sheets("Gutschrift").Cells(79, 5) 'Pfand Artikel
ActiveCell.Offset(0, 36) = Sheets("Gutschrift").Cells(80, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 37) = Sheets("Gutschrift").Cells(81, 5) 'Pfand Artikel
ActiveCell.Offset(0, 38) = Sheets("Gutschrift").Cells(82, 4) 'Pfand Stückzahl
ActiveCell.Offset(0, 39) = Sheets("Gutschrift").Cells(83, 5) 'Pfand Artikel
Sheets("Gutschrift").Select
Range("G26:G55").ClearContents
Range("D26:D55").ClearContents
Range("A1").Select
' Arbeitsmappen werden wieder verstekt
Sheets("Verkaufte Artikel-Normal").Select
Dim wks As Worksheet
Dim iQuell As Integer, iGetr As Integer
Dim lgZeile As Long, iZaehl As Integer
Set wks = Worksheets("Verkaufte Artikel")
'alle Zeilen in Verkaufte Artikel ab Zeile 10
For lgZeile = 10 To Range("A65536").End(xlUp).Row
Range(Cells(lgZeile, 1), Cells(lgZeile, 5)).Copy wks.Cells(lgZeile, 1)
'alle "Getränke" in "Verkaufte Artikel Statistik"
For iGetr = 7 To 49
'alle Artikelbeschreibungen in "Verkaufte Artikel"
For iQuell = 8 To 60
If Cells(lgZeile, iQuell) = wks.Cells(9, iGetr) Then
iZaehl = iZaehl + Cells(lgZeile, iQuell - 1)
End If
Next
If iZaehl <> 0 Then
wks.Cells(lgZeile, iGetr) = iZaehl
Else
wks.Cells(lgZeile, iGetr) = ""
End If
iZaehl = 0
Next
Next
'ActiveSheet.Protect ("test")
Sheets("Rechnung").Select
ActiveSheet.Protect ("test")
Worksheets("Kunden").Visible = xlVeryHidden
Worksheets("Forderungen").Visible = xlVeryHidden
Worksheets("Einnahmen Übersicht").Visible = xlVeryHidden
Worksheets("Journal Gutschrift Übersicht").Visible = xlVeryHidden
Worksheets("Personal").Visible = xlVeryHidden
Worksheets("Artikel").Visible = xlVeryHidden
Worksheets("Kundenpreise").Visible = xlVeryHidden
Worksheets("Infos f YH").Visible = xlVeryHidden
Worksheets("Journal").Visible = xlVeryHidden
Worksheets("Lieferart").Visible = xlVeryHidden
Worksheets("Verkaufte Artikel").Visible = xlVeryHidden
Worksheets("Verkaufte Artikel-Normal").Visible = xlVeryHidden
Worksheets("Pfand Kosten").Visible = xlVeryHidden
Sheets("ST Verkaufte Artikel Gesamt").Visible = xlVeryHidden
Sheets("ST Pfand Kosten").Visible = xlVeryHidden
Worksheets("Gutschrift").Visible = xlVeryHidden
Worksheets("Journal Gutschrift").Visible = xlVeryHidden
Rechnung = Sheets("Rechnung").Select
Range("A1").Select
Sheets("Rechnung").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=0, Collate:=True
Range("A1").Select
sExit:
Application.CommandBars("Stop Recording").Visible = False
Range("D26:D55").ClearContents
Range("E26:E55").ClearContents
Range("D64:D69").ClearContents
Range("E64:E69").ClearContents
Range("K64").ClearContents
Range("A1").Select
On Error GoTo 0
'VBA bzw. Makroausführung im Hintergrund ist nicht mehr aktiv
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub