Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 00:42:03
Listbox mit gefilterten Daten füllen
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1324to1328
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1324to1328
1324to1328
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Hilfe!

Hilfe!
04.08.2013 14:03:46
Frank
Hallo ,
Ich brauche dringend Hilfe bei einem Makro das ich mir zusammengeschnitten habe aus diversen Muster Makros die man so im Netz findet.
Sub Muester_fuellen()
Dim rn As Range
Dim i   As Long
Dim ws  As Worksheet
Set rn = ThisWorkbook.Worksheets("Kenndaten").UsedRange
Application.ScreenUpdating = False
For i = 2 To rn.Rows.Count
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = rn.Cells(i, 1).Value
rn.Rows(i).Columns("$B:$J").Copy
ws.Range("$A$21").PasteSpecial
Next i
Application.ScreenUpdating = True
End Sub
Dieses Makro macht fast alles was ich möchte,außer das es nicht mein "Rechnungsmuster füllt sondern immer wieder ein neues Blatt erstellt.
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
Dieser Befehlt muss irgendwie geändert werden,sodass ich irgendwie mein Rechnungsmuester aufrufe.
Das Makro soll also jede Reihe aus meiner Kenndaten Tabelle kopieren, jedes mal ein neue Rechnungsmuester Kopie anlegen und es fuellen statt immer wieder ein neues gefuelltes Blatt anzulegen.
Bitte nur dieses Makro umändern, da ich es mit meinen wenigen Vba Kenntnissen begreife.
Danke schonmal für die Hilfe

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe!
04.08.2013 15:00:30
Hajo_Zi
irgendwie verstehe ich den Beitrag nicht. Was wohl daran liegt das de obere Teil nicht mit dem unteren zusammen passt.
Oben wird geschrieben es soll keine neue Tabelle angelegt werden, aber unten 
Das Makro soll also jede Reihe aus meiner Kenndaten Tabelle kopieren, jedes mal ein neue Rechnungsmuester Kopie anlegen

Daraus könnte man schlussfolgern es gibt eine Vorlage, deren Namen und Ablage Ort wir nicht kennen.

AW: Hilfe!
04.08.2013 15:39:45
Frank
Das Makro soll arbeiten wie folgt:
Es gibt eine Kenndaten Tabelle mit Daten.Dann gibt es ein Rechnungsmuster, für jede Reihe der kenndaten Tabelle soll eine neue Rechnung kopiert und mit den gefuellt werden, bis die Reihe der Kenndaten Tabelle abgearbeitet ist.
Das gepostet Makro, kopiert jede Reihe aus der Tabelle und erstellt immer ein neues Blatt und fuellt es.
Es soll statt ein neues Blatt die Rechnungskopie anlegen und fuellen.

Anzeige
Du drehst Dich im Kreis
04.08.2013 16:06:38
Matthias
Hallo (soviel Zeit sollte sein!)
Was ist bei Dir ein Rechnungsmuster ?
Ist das ein RegisterblattName, oder was ist das?
Lad eine Bsp.Mappe hoch! In dieser erklärst Du bitte was von wo aus -> wohin soll.
Gruß Matthias (Eine Grußformal am Ende macht Dich dann evtl. auch wieder symphatisch)

AW: Hilfe-Versuch!
04.08.2013 16:46:06
Gerd
Hallo Frank,
deine Beschreibungen sind -exceltechnisch- wirklich sehr sparsam. Den folgenden Code kannst du deshalb als Versuch einer Interpretation ansehen.
Sub Muester_fuellen()
Dim rn As Range
Dim i   As Long
Dim ws  As Worksheet
Dim wsRM As Worksheet
Set wsRM = ThisWorkbook.Worksheets("Rechnungsmuster") 'ANPASSEN
Set rn = ThisWorkbook.Worksheets("Kenndaten").UsedRange
Application.ScreenUpdating = False
For i = 2 To rn.Rows.Count
Set ws = wsRM.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsRM.Name = rn.Cells(i, 1).Value
rn.Rows(i).Columns("$B:$J").Copy
wsRM.Range("$A$21").PasteSpecial
Next i
Application.ScreenUpdating = True
End Sub

Gruß Gerd

Anzeige
AW: Hilfe-Versuch!
04.08.2013 18:09:36
Frank
Danke Gerd für deine Hilfe. Wenn ich das Makro starte erscheint ein Fenster mit "Fehler beim Kompilieren Methode oder Datenobjekt nicht gefunden"

Warum ist das blos so schwer,...
04.08.2013 18:32:34
Matze
Hallo Frank,
..das zu tun was dir Matthias L. geschrieben hat ?
Der Code von Erich ist nach seiner Interpretation entstanden,..
dein sieht vermutlich ganz anders aus.
Also her mit der Datei!
Matze

mir isses eh "wurscht" ...
04.08.2013 18:54:34
Matthias
Hallo Matze
weil Anstand (also Benehmen) bei Frank = Null :-(
... aber pass bitte besser auf, nicht Erich sondern Gerd.
Ich bin jetzt eh raus, hatte zwar schon ne Bsp.Datei erstellt, aber wenn er ja eh nicht will ...
Ich hatte schließlich ca. 40 min. vor Gerd seinem Vorschlag mal nachgefragt.
Was solls, ich hab das Problem nicht und nach ner Antwort bettel ich auch nicht.
Gruß Matthias

Anzeige
AW: Hilfe!
04.08.2013 20:22:22
Gerd
Servus,
der Kompiler hat immer Recht. Etwas überarbeitet: 
Sub Muester_fuellen()
Dim rn As Range
Dim i   As Long
Dim ws  As Worksheet
Dim wsRM As Worksheet
Set wsRM = ThisWorkbook.Worksheets("Rechnungsmuster") 'ANPASSEN
Set rn = ThisWorkbook.Worksheets("Kenndaten").UsedRange
Application.ScreenUpdating = False
For i = 2 To rn.Rows.Count - rn.Row + 1
wsRM.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ws.Name = rn.Cells(i, 1).Value
rn.Rows(i).Columns("$B:$J").Copy
ws.Range("A21").PasteSpecial
Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True
Set wsRM = Nothing: Set ws = Nothing: Set rn = Nothing
End Sub
Gruß Gerd

Anzeige
AW: Hilfe!
05.08.2013 20:37:24
Frank
Rieses Großes Danke Gerd!!!!
Ich habe da noch ein Anliegen und zwar habe ich das Makro bearbeitet, sodass es die Kopie auf dem selben Ordner anliegt wie die TabellenMappe. Jetzt möchte ich aber das im Falle der Erweiterung der Kenndaten Tabelle, die Kopien die bereits exestieren einfach überschrieben werden und die neuen auf dem Ordner abgelegt werden.
Sub Schaltfläche2_KlickenSieAuf()
Dim rn As Range
Dim i   As Long
Dim ws  As Worksheet
Dim wsRM As Worksheet
Set wsRM = ThisWorkbook.Worksheets("Rechnung")
Set rn = ThisWorkbook.Worksheets("Kenndaten").UsedRange
Application.ScreenUpdating = False
For i = 2 To rn.Rows.Count
wsRM.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ws.Name = rn.Cells(i, 1).Value
rn.Rows(i).Columns("$B:$J").Copy
ws.Range("A21").PasteSpecial
Application.CutCopyMode = False
ws.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close True
Next i
Application.ScreenUpdating = True
Set wsRM = Nothing: Set ws = Nothing: Set rn = Nothing
End Sub

Anzeige
AW: Hilfe!
06.08.2013 21:46:45
Gerd
Hallo Frank,
das geht sicher effektiver. Als Ansatz: 
Sub Schaltfläche2_KlickenSieAuf()
Dim rn As Range
Dim i   As Long
Dim ws  As Worksheet
Dim wsRM As Worksheet
Dim strDatei As String
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 & ".xl*")
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
If ActiveWorkbook Is ThisWorkbook Then
ws.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xl."
End If
ActiveWorkbook.Close True
Next i
Application.ScreenUpdating = True
Set wsRM = Nothing: Set ws = Nothing: Set rn = Nothing
End Sub
Servus
Gerd

Anzeige
AW: Hilfe!
08.08.2013 17:20:02
Frank
Vielen Dank Gerd!!! Es klappt alles super...leider habe ich nun ein weiteres Anliegen. Das Makro soll so bleiben nur mit ein paar Erweiterungen!!!!!!
Und zwar habe ich nun weitere Muster erstellt die sich alle voneinander unterscheiden, diese befinden sich in der selben Mappe. Jede Reihe der Kenndaten Tabelle soll für ein bestimmtes Muster individuell gefuellt werden.
Ich habe die Kenndaten Tabelle erweitertt, sodass der Name des Musters sich in der Reihe befindet.
Es soll statt die eine Musterrechnung nun individuell für jede Reihe ein anderes Muster gefuellt werden oder eventuell das selbe wenn es so sein soll.
Ich habe paar Ansatze weiss aber sie nicht einzufügen ...bitte um Hilfe.
das hier ist dafür damit das makro durch den String weiss welches Muster gefuellt werden soll
Dim Typ As String
Typ = Cells(i, 8)
Worksheets(Typ).Activate
und das hier damit ich entscheide wo individuell noch was zusätzlich eingefügt werden kann, das ist nur son beispiel, das kann ich selbst anpassen für alle...es muss nur eingesetzt werden
If Typ = "......" Then
Cells(2, 6) = Worksheets("Kenndaten").Cells(Zeile, 7)
Cells(3, 7) = Worksheets("Kenndaten").Cells(Zeile, 9)
Cells(1, 4) = Worksheets("Kenndaten").Cells(Zeile, 2)
Cells(3, 7) = Worksheets("Kenndaten").Cells(Zeile, 13)
End If
If Typ = "....." Then
Cells(4, 4) = Worksheets("Kenndaten").Cells(Zeile, 4)
End If
Danke schonmal für deine / eure Hilfe !!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige