Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1608to1612
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA bestimmte Reiter durchsuchen/dynam. Sverweis

VBA bestimmte Reiter durchsuchen/dynam. Sverweis
18.02.2018 10:10:57
Gesa
Guten Morgen zusammen,
ich habe folgendes Makro gefunden, dass grundsätzlich funktioniert, aber würde es gerne noch etwas anpassen:
Das Makro kopiert mir aus allen Reitern, die in H15 "Rechn.-Nr.:" stehen haben (außer Reiter "RechBetrag" und "Rechnung") die Rechnungsnummer (Zelle I15), den Rechnungsbetrag (Zelle I38) und das Rechnungsdatum (Zelle I12) die Werte in die Spalten A, B und C im Reiter "RechBetrag". Das funktioniert auch (zumindest meistens :-)).
Nun zu meinen vier Fragen/gewünschten Anpassungen:
1. Im Reiter "RechBetrag" werden die Werte erst ab Zeile 16 ausgegeben und dann ab Zeile 40 noch einmal (ich habe also alle Informationen doppelt kopiert). Wie kann ich die Daten ab Zeile 1 und nur einmalig ausgeben?
2. Ist es möglich, dass die Werte nur kopiert werden, wenn
a) sich für eine Rechnungsnummer das Datum und/oder der Betrag geändert haben (wahrscheinlich ist ein Abgleich mit den bestehenden Werten in RechBetrag nötig, da der bestehende "Rechnungsreiter" (z.B. für Rechn.Nr. 2018-01) gelöscht wird und mit den geänderten Daten neu erstellt)
b) neue Rechnungnummern hinzukommen, soll nicht alles neu kopiert werden, sondern nur a) und die neuen Rechnungnummern.
Hmm...irgendwie ist es schwer zu beschreiben, was ich bei Nr. 2 meine. Ich möchte quasi einen "dynamischen" Sverweis, der mir Betrag und Datum zu einer Rechnungsnummer in "RechBetrag" darstellt. Der Sverweis muss die Werte aus den vordefinierten Zellen der verschiedenen Rechnungsreitern ziehen, aber die Reiter werden ja erst nach und nach erstellt (Reitername: "Nr." & variable Werte), so dass ich nicht auf bestehende Reiter gehen kann.
Da die Gesamtmenge der Rechnungsnummern überschaubar ist (ca. 100 pro Jahr), kann ich auch in RechBetrag alle Rechnungsnummern von 2018-01 bis 2018-99 eintragen, wenn dies einfacher wäre.
3.) aktuell nimmt das Makro ja alle wks, die nicht Rechnung oder RechBetrag heißen. Kann man es so ändern, dass es nur die Reiter mit "Nr." im Reiternamen sucht (z.B. "Nr. 2018-01_MaxMustermann")?
4.) Ich erhalte immer wieder den Fehler Laufzeit 1004, Method 'Select' Object an der Stelle "wks.select". Im Forum habe ich schon gefunden, dass es an meinen ausgeblendeten Reitern liegt. Nun habe ich ein anderes Makro, dass alle Rechnungsreiter vorher einblendet. Funktioniert auch super. Aber ich habe noch andere Reiter (z.B. Vertrag, Übersicht etc), die weiterhin ausgeblendet sind. Manchmal läuft das Makro durch, manchmal hängt es sich an dieser Stelle auf. Kann es an meinen anderen ausgeblendeten Reitern liegen? Eigentlich möchte ich ja nur, dass die Rechnungsreiter abgefragt werden. Da auch die Anzahl der anderern Reiter variable ist (z.B. Vertrag 1, Vertrag 2, ....) möchte ich eigentlich nicht jedes mal alles einblenden und alles ausblenden.
Uff, viele Fragen und vorallem Fragezeichen in meinem Kopf. Für Vorschläge/Ideen bin ich sehr dankbar!
Viele Grüße
Gesa
PS: Könnte mir jemand erklären, was es mit i = 1 t 30 auf sich hat? Mir ist klar, dass hier gezählt wird, aber bei diesem Makro erschließt sich mir nicht ganz der Sinn dahinter bzw. was dadurch ausgelöst wird. Muss ich das auf i = 1 to 100 setzen, wenn ich 100 Rechnungen im Jahr habe? Danke!
aktuelles Makro
Sub Betrag_Rechnung()
Sheets("RechBetrag").Visible = True
Application.EnableEvents = False
Sheets("RechBetrag").Select
Range("A:C").Clear
Dim wks As Worksheet
Dim a As Long
Dim i As Long
For i = 1 To 30
For Each wks In ThisWorkbook.Worksheets
If wks.Name  "RechBetrag" And wks.Name  "Rechnung" Then
If wks.Range("H15") = "Rechn.-Nr.:" Then
wks.Select
Range("I15").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wks.Select
Range("I38").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wks.Select
Range("I12").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "c").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
i = i + 1
End If
Next
Next
Application.EnableEvents = True
Sheets("RechBetrag").Visible = False
End Sub

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA bestimmte Reiter durchsuchen/dynam. Sverweis
18.02.2018 10:37:40
Werner
Hallo Gesa,
hier jetzt nur mal ein Teil:
-Makro bereinigt, die ganzen Selects raus
-keine doppelten Werte mehr
-Tabellenblätter die mit Nr. beginnen werden genommen
Sub Betrag_Rechnung()
Dim wks As Worksheet
Dim a As Long, i As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Sheets("RechBetrag").Visible = True
Sheets("RechBetrag").Range("A:C").ClearContents
For Each wks In ThisWorkbook.Worksheets
For i = 1 To 30
If Left(wks.Name, 3) = "Nr." Then
If wks.Range("H15") = "Rechn.-Nr.:" Then
.Range("I15").Copy
Sheets("RechBetrag").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
wks.Range("I38").Copy
Sheets("RechBetrag").Cells(i, "B").PasteSpecial Paste:=xlPasteValues
wks.Range("I12").Copy
Sheets("RechBetrag").Cells(i, "C").PasteSpecial Paste:=xlPasteValues
End If
End If
Next i
Next wks
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With
Sheets("RechBetrag").Visible = False
End Sub
Den Rest verstehe ich leider nicht. Bitte eine Beispielmappe mit 1-2 Blättern mit Daten, in der du erklärst/aufzeigst was du machen möchtest.
Gruß Werner
Anzeige
wobei ich eben sehe....
18.02.2018 12:52:41
Werner
Hallo,
..das die For i = 1 To 30 ja Quatsch ist.
Bei deiner Version läßt du die Schleife 30 mal über deine Tabellenblätter laufen ?
Bei meiner Version läuft die Schleife jetzt aber 30 mal in den einzelnen Blättern und kopiert 30 mal die gleichen Werte, das ist ja auch Quatsch ?!?
Zeig mal eine Beispielmappe.
Gruß Werner
AW: Beispieldatei
18.02.2018 16:21:31
Gesa
Hallo Werner,
erst einmal vielen Dank für deine Antwort!
So, ich hoffe ich mache das jetzt richtig mit dem Upload der Datei.
https://www.herber.de/bbs/user/119891.xlsm
Die "Rechnungsreiter" und der Reiter "RechBerech" sind aktuell ausgeblendet, so wie ein Platzhalter für verschiedene weitere ausgeblendete Reiter. Dies entspricht meinem "Setup" der Datei. Über andere Makros erstelle ich dann immer wieder weitere Rechnungen (z.B. 2018-06 mit anderem Datum etc) - daher der Suche nach einer "dynamischen" Lösung.
Ich habe extra mein Makro noch nicht mit deinem Vorschlag angepasst, damit vielleicht klarer ist was ich aktuell versuche.
Beim Testen ist das Makro einmal problemlos durchgelaufen und beim zweiten Mal kam direkt wieder der Laufzeitfehler. Nach "BlätterEinAus" ist quasi das Makro an der Stelle wks.select abgebrochen. Also gestoppt und die nächsten Schritte manuell durchgeklickt - da hat es dann ohne Probleme geklappt. Komisch.
Vielen Dank für deine Zeit und viele Grüße
Gesa
Anzeige
AW: Beispieldatei
18.02.2018 19:22:37
Werner
Hallo Gesa,
lad bitte die Mappe nochmal hoch, aber als .xlsx (ohne Makros). Im Moment kann ich hier keine .xlsm herunterladen.
Gruß Werner
AW: Beispieldatei
18.02.2018 20:31:38
Gesa
Hallo Werner,
anbei die neue Datei als normale Excel ohne Makro:
https://www.herber.de/bbs/user/119894.xlsx
In der Makro-Version haben ich folgende Makros drin:
Sub Betrag_Rechnung()
BlätterEinAus
Sheets("RechBetrag").Visible = True
Application.EnableEvents = False
Sheets("RechBetrag").Select
Range("A:C").Clear
Dim wks As Worksheet
Dim a As Long
Dim i As Long
For i = 1 To 30
For Each wks In ThisWorkbook.Worksheets
If wks.Name  "RechBetrag" And wks.Name  "Rechnung" Then
If wks.Range("H15") = "Rechn.-Nr.:" Then
wks.Select
Range("I15").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wks.Select
Range("I38").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wks.Select
Range("I12").Select
Selection.Copy
Sheets("RechBetrag").Select
Cells(i, "c").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
i = i + 1
End If
Next
Next
Application.EnableEvents = True
Sheets("RechBetrag").Visible = False
BlätterEinAus
End Sub
Sub BlätterEinAus()
Dim aPartNames
Dim iX As Integer
Dim ws As Worksheet
aPartNames = Array("Nr.")
For Each ws In ThisWorkbook.Worksheets
For iX = 0 To UBound(aPartNames)
If InStr(ws.Name, aPartNames(iX)) > 0 Then
ws.Visible = Not (ws.Visible)
Exit For
End If
Next iX
Next ws
End Sub
Danke und viele Grüße
Gesa
Anzeige
AW: Beispieldatei
18.02.2018 22:27:18
Werner
Hallo Gesa,
was noch interessant wäre, wie du denn die einzelnen "Rechnungsblätter" erstellst? Ich gehe mal davon aus, dass du da ein Vorlagenblatt hast, das du jeweils kopierst.
Machst du das "händisch" oder per Makro. Wenn per Makro, dann zeig doch mal das Makro dazu.
Gruß Werner
AW: Beispieldatei
19.02.2018 12:20:19
Gesa
Hallo Werner,
ich fülle per Makro Hilfsfelder (Spalten A&B, im Beispiel gelöscht) im Reiter "Rechnung" aus (in der Beispiel Datei ist das Blatt nicht gefüllt) und kopiere dann den Reiter und benenne ihn um etc. Hier die Makros:
Private Sub CommandButton8_Click()
'Rechnung erstellen klicken
'Rechnung füllen
Worksheets("Rechnung").Select
If Me.ComboBox1 = Empty Then
msg = MsgBox("Bitte ein Brautpaar auswählen.", vbOKOnly + vbInformation, "Brautpaar auswählen" _
)
Exit Sub
End If
Dim i As Long, Lastrow As Long
Lastrow = Sheets("Übersicht").Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To Lastrow
If Sheets("Übersicht").Cells(i, "C").Value = (Me.ComboBox1) And (Sheets("Übersicht").Cells(i, " _
AN").Value = Empty Or Sheets("Übersicht").Cells(i, "AN").Value = 0) And Me.OptionButton1 = True Then
msg = MsgBox("Bitte erst eine Rechnungsnummer bei 'Honorarrechnung' eingeben.", vbOKOnly +  _
vbInformation, "Brautpaar auswählen")
Rechnungen.Show
Exit Sub
End If
Next
Dim j As Long, Lastrowj As Long
Lastrowj = Sheets("Übersicht").Range("C" & Rows.Count).End(xlUp).Row
For j = 4 To Lastrowj
If Sheets("Übersicht").Cells(j, "C").Value = (Me.ComboBox1) And (Sheets("Übersicht").Cells(j, " _
BQ").Value = Empty Or Sheets("Übersicht").Cells(j, "BQ").Value = 0) And Me.OptionButton2 = True Then
msg = MsgBox("Bitte erst eine Rechnungsnummer bei 'Restrechnung' eingeben.", vbOKOnly +  _
vbInformation, "Brautpaar auswählen")
Rechnungen.Show
Exit Sub
End If
Next
Dim k As Long, Lastrowk As Long
Lastrowk = Sheets("Übersicht").Range("C" & Rows.Count).End(xlUp).Row
For k = 4 To Lastrowk
If Sheets("Übersicht").Cells(k, "C").Value = (Me.ComboBox1) And (Sheets("Übersicht").Cells(k, " _
BW").Value = Empty Or Sheets("Übersicht").Cells(k, "BW").Value = 0) And Me.OptionButton3 = True Then
msg = MsgBox("Bitte erst eine Rechnungsnummer bei 'Sonderrechnung' eingeben.", vbOKOnly +  _
vbInformation, "Brautpaar auswählen")
Rechnungen.Show
Exit Sub
End If
Next
If Me.OptionButton1 = False And Me.OptionButton2 = False And Me.OptionButton3 = False Then
msg = MsgBox("Bitte eine Rechnungsart auswählen.", vbOKOnly + vbInformation, "Rechnungsart  _
auswählen")
Exit Sub
End If
'alle bisherigen Rechnungen einblenden (sonst funktioniert RechBerech nicht!)
BlätterEinAus
'zeitliche Verzögerung von 2 sek, damit alle Blätter eingeblendet werden können
With ActiveWorkbook
Application.Wait (Now + TimeValue("0:00:02"))
End With
Dim n As Long, Lastrown As Long
Lastrown = Sheets("Übersicht").Range("C" & Rows.Count).End(xlUp).Row
For n = 4 To Lastrown
If Sheets("Übersicht").Cells(n, "C").Value = (Me.ComboBox1) Then
Sheets("Übersicht").Cells(n, "T") = Me.TextBox10.Value
Sheets("Übersicht").Cells(n, "AE") = Me.TextBox15.Value
Sheets("Übersicht").Cells(n, "Y") = Me.TextBox14.Value
Sheets("Übersicht").Cells(n, "W") = Me.TextBox13.Value
Sheets("Übersicht").Cells(n, "AI") = Me.TextBox12.Value
Sheets("Übersicht").Cells(n, "AC") = Me.TextBox20.Value
Sheets("Übersicht").Cells(n, "U") = Me.TextBox16.Value
Sheets("Übersicht").Cells(n, "AF") = Me.TextBox18.Value
Sheets("Übersicht").Cells(n, "Z") = Me.TextBox17.Value
Sheets("Übersicht").Cells(n, "AK") = Me.TextBox11.Value
Sheets("Übersicht").Cells(n, "AB") = Me.TextBox19.Value
Sheets("Übersicht").Cells(n, "AS") = Me.TextBox24.Value
If Me.CheckBox2 = True Then Sheets("Übersicht").Cells(n, "aj") = "ja"
If Me.CheckBox2 = False Then Sheets("Übersicht").Cells(n, "aj") = ""
If Me.CheckBox1 = True Then Sheets("Übersicht").Cells(n, "S") = "ja"
If Me.CheckBox6 = True Then Sheets("Übersicht").Cells(n, "V") = "ja"
If Me.CheckBox7 = True Then Sheets("Übersicht").Cells(n, "X") = "ja"
If Me.CheckBox8 = True Then Sheets("Übersicht").Cells(n, "AD") = "ja"
If Me.CheckBox5 = True Then Sheets("Übersicht").Cells(n, "AA") = "ja"
If Me.CheckBox4 = True Then Sheets("Übersicht").Cells(n, "ag") = "ja"
If Me.CheckBox3 = True Then Sheets("Übersicht").Cells(n, "ah") = "ja"
If Me.CheckBox1 = False Then Sheets("Übersicht").Cells(n, "S") = ""
If Me.CheckBox6 = False Then Sheets("Übersicht").Cells(n, "V") = ""
If Me.CheckBox7 = False Then Sheets("Übersicht").Cells(n, "X") = ""
If Me.CheckBox8 = False Then Sheets("Übersicht").Cells(n, "AD") = ""
If Me.CheckBox5 = False Then Sheets("Übersicht").Cells(n, "AA") = ""
If Me.CheckBox4 = False Then Sheets("Übersicht").Cells(n, "ag") = ""
If Me.CheckBox3 = False Then Sheets("Übersicht").Cells(n, "ah") = ""
End If
Next
'Worksheets("Rechnung").Range("A8:A10").Clear
Range("A12").Select
Range("A12") = ComboBox1.Value
If OptionButton1.Value = True Then
Range("A15") = "Honorar"
End If
If OptionButton2.Value = True Then
Range("A15") = "Rest"
End If
If OptionButton3.Value = True Then
Range("A15") = "Sonder"
End If
'If TextBox22.Value  TextBox19.Value Then
'Worksheets("Rechnung").Range("A8") = TextBox19
'End If
'If TextBox6.Value  TextBox12.Value Then
'Worksheets("Rechnung").Range("A9") = TextBox12
'End If
'If TextBox21.Value  TextBox20.Value Then
'Worksheets("Rechnung").Range("A10") = TextBox20
'End If
ActiveSheet.Calculate
'je nach Daten für Rechnung werden nun die Preise aus dem Reiter Preise Leistung gezogen
Preise
ActiveSheet.Calculate
Unload Me
Unload Buchungsoptionen
Worksheets("Rechnung").Select
Range("c29").Select
ActiveSheet.Calculate
'die Rechnung wird kopiert, umbenannt und als PDF weggespeichert
Rechnung_kopieren
'für alle Rechnungen werden Rechnungsdatum und Preis ermittelt (jedesmal neu!) und dann in die Ü _
bersicht gezogen, so dass die Infos in der Rechnungsübersicht gefüllt sind
Betrag_Rechnung
Worksheets("Cockpit").Select
msg = MsgBox("Rechnung wurde erfolgreich erstellt.")
End Sub

Sub Rechnung_kopieren()
Sheets("Rechnung").Select
Sheets("Rechnung").Copy Before:=Sheets(1)
Cells.Select
Range("C19").Activate
Selection.EntireColumn.Hidden = False
Range("D12:I27").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D28:H37").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Rechnung (2)").Select
Sheets("Rechnung (2)").Name = "Nr. " & Range("I15") & "_" & Range("B15") & "_" & Range("I12" _
).Value
Columns("A:B").Select
Range("A19").Activate
Selection.EntireColumn.Hidden = True
Application.CutCopyMode = False
ActiveSheet.Move After:=Sheets(Sheets.Count)
End Sub

Anzeige
erster Teil
19.02.2018 17:16:11
Werner
Hallo Gesa,
dein Makro zum Kopieren der Rechnungsvorlage habe ich angepasst, Teste mal:
Sub Rechnung_kopieren()
Application.ScreenUpdating = False
'alle Blätter mit Nr.? einblenden
For Each Worksheet In ThisWorkbook.Worksheets
If Left(Worksheet.Name, 3) = "Nr." Then Worksheet.Visible = True
Next Worksheet
'neues Blatt am Ende eifügen
Worksheets("Rechnung").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Nr. " & Range("I15") & "_" & Range("B15") & "_" & Range("I12").Value
Columns("C:C").Hidden = False
'Formeln durch Werte ersetzen
Range("D12:I27").Value = Range("D12:I27").Value
Range("D28:H37").Value = Range("D28:H37").Value
Columns("A:B").Hidden = True
'alle Blätter mit Nr.? ausblenden
For Each Worksheet In ThisWorkbook.Worksheets
If Left(Worksheet.Name, 3) = "Nr." Then Worksheet.Visible = False
Next Worksheet
Worksheets("Cockpit").Activate
Application.ScreenUpdating = True
End Sub
Da sind jetzt die ganzen Selects raus.
Du schreibst hier in deinem Code:
'die Rechnung wird kopiert, umbenannt und als PDF weggespeichert
Rechnung_kopieren

Da wird aber nichts als PDF weggespeichert.
Zeig doch bitte noch dein Makro Preise.
Der Rest kommt dann noch. Kann aber nur den nackten Code einstellen, mit hochladen von Dateien ist bei mir im Moment nichts (Arbeitsplatzrechner).
Gruß Werner
Anzeige
AW: erster Teil
19.02.2018 21:30:11
Gesa
Hallo Werner,
das funktioniert ganz wunderbar! Vielen Dank. Ich habe auch direkt wieder gelernt, wie ich meine Makros "sauberer" machen kann. Klasse!
Vorallem das ein-/ausblenden der spezifischen Sheets ist genial. (Falls dies hier jemand mal als Referenz nutzt - Frage 3 ist somit beantwortet)
Das PDF-Speichern ist ein extra Marko, dass ich nicht nochmal dargestellt habe. Klappt aber einwandfrei.
zweiter Teil
19.02.2018 17:52:03
Werner
Hallo Gesa,
hier das Makro zum Sammeln der Daten aus den einzelnen Rechnungsblättern:
Als Vorbereitung mußt du in deiner Vorlage "Rechnung" folgende Bereichsnamen definieren:
Rechtsklick auf Zelle G12 - Namen definieren - Name: Rechnungsdatum - Pulldown Bereich: Blatt "Rechnung" auswählen, ok
Rechtsklick auf Zelle G15 - Namen definieren - Name: Rechnungsnummer - Pulldown Bereich: Blatt "Rechnung" auswählen, ok
Rechtsklick auf Zelle G38 - Namen definieren - Name: Gesamtsumme - Pulldown Bereich: Blatt "Rechnung" auswählen, ok
Sub Betrag_Rechnung()
Dim wks As Worksheet, i As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
i = 5
Sheets("RechBetrag").Columns("A:C").ClearContents
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 3) = "Nr." Then
With wks
If .Range("H15") = "Rechn.-Nr.:" Then
.Range("Rechnungsnummer").Copy
Sheets("RechBetrag").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
.Range("Gesamtsumme").Copy
Sheets("RechBetrag").Cells(i, "B").PasteSpecial Paste:=xlPasteValues
.Range("Rechnungsdatum").Copy
Sheets("RechBetrag").Cells(i, "C").PasteSpecial Paste:=xlPasteValues
i = i + 1
End If
End With
End If
Next wks
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With
End Sub
Gruß Werner
Anzeige
AW: zweiter Teil
19.02.2018 21:42:03
Gesa
Hallo Werner,
tausend Dank!!! Das Makro funktioniert perfekt!
Ich musstes dein Makro noch ein bisschen anpassen:
- ich habe i = 1 statt 5 gesetzt; damit starte ich in Zeile 1 im Reiter RechBerech
- ich habe die Blätter ein-/ausblenden aus dem anderen Makro hier eingefügt, da die Blätter eingeblendet sein müssen, sonst kommt wieder der Laufzeitfehler
- ich musste die Bereichsnamen wieder als Zellen ändern (z.B. I15 statt Rechnungsnummer), da ich den Bereichsnamen nur einmal vergeben kann und beim kopieren der Rechnungsvorlage wird dieser nicht in die "neue" Rechnung übernommen.

'alle Blätter mit Nr.? einblenden
For Each Worksheet In ThisWorkbook.Worksheets
If Left(Worksheet.Name, 3) = "Nr." Then Worksheet.Visible = True
Next Worksheet
Dim wks As Worksheet, i As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'mit i = 1 starte ich in Zeile 1 im Reiter RechBerech
i = 1
Sheets("RechBetrag").Columns("A:C").ClearContents
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 3) = "Nr." Then
With wks
If .Range("H15") = "Rechn.-Nr.:" Then
.Range("I15").Copy
Sheets("RechBetrag").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
.Range("I38").Copy
Sheets("RechBetrag").Cells(i, "B").PasteSpecial Paste:=xlPasteValues
.Range("I12").Copy
Sheets("RechBetrag").Cells(i, "C").PasteSpecial Paste:=xlPasteValues
i = i + 1
End If
End With
End If
Next wks
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With
'alle Blätter mit Nr.? ausblenden
For Each Worksheet In ThisWorkbook.Worksheets
If Left(Worksheet.Name, 3) = "Nr." Then Worksheet.Visible = False
Next Worksheet
End Sub
Somit sind Fragen 1, 3 und 4 beantwortet. Frage 2 ist hinfällig geworden, weil dein Makro so gut funktioniert :-)
Vielen, vielen Dank für deine ganze Zeit und Hilfe! Du hast mir wirklich sehr geholfen!
Viele Grüße
Gesa
Anzeige
Welcher Laufzeitfehler.....
19.02.2018 22:33:20
Werner
Hallo Gesa,
....und in welcher Codezeile? Der Code läuft ohne Fehler bei ausgeblendet Blättern.
Gruß Werner
AW: Welcher Laufzeitfehler.....
20.02.2018 19:31:28
Gesa
Hallo Werner,
da war ich gestern abend wohl schon zu müde. Du hast Recht, das Makro funktioniert auch bei den ausgeblendeten Blättern - mea culpa.
Danke noch mal und viele Grüße
Gesa
Gerne u.Danke für die Rückmeldung. o.w.T.
20.02.2018 21:33:18
Werner
Fehler beim Makro Rechnung_kopieren
19.02.2018 18:08:54
Werner
Hallo Gesa,
habe eben gesehen, dass mir bei dem Makro, beim Namen zusammensetzen ein _ Unterstrich statt einem - Bindestrich reingerutscht ist.
Müsste so sein:
ActiveSheet.Name = "Nr. " & Range("I15") & "-" & Range("B15") & "_" & Range("I12").Value
Gruß Werner
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige