---

Muster03-10-04.zip

Hallo Profis,
wie kann ich mit VBA aus einer Liste (siehe Muster/halb-Seite)
einen Wert --> in diesem Fall eine Halbnummer <-- nehmen,
das Musterblatt kopieren und "in die Halbnummer" umbennen
(Beispiel 4110)
und dann den Wert neben dieser Halbnummer
= Materialname in das Feld "C3" einfügen.
Das Ganze sollte solange gemacht werden bis alle ca. 300 Halbnummern ein "eigenes Blatt" haben.

Ich hoffe ich habe mich einigermaßen Verständlich ausgedrückt.
Mein Wissen in VBA ist ca.:0,05%.
Normalerweise füge ich die Werte per Hand ein, aber wenn es per VBA ginge wäre das eine grosse Hilfe.

Für Tipps und Tricks wäre ich Dankbar.

Gruss
Primus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi again ;-)

naja profimäßig isses nich grade,
fiel mir grad nix bessres als ein 'dämliches' GoTo ein,
wusste nämlich nicht, ob da mal doppelte Halb-Nummern auftauchen könnten.
Die Scleife gilt bis zur letzten belegten Zelle in Spalte A und
ich bin davon ausgegangen, das keine Leerzellen innerhalb drinne sind.

Code:

---

'normales Modul
Option Explicit
Sub Primus()
  Dim ws As Worksheet, halb As Worksheet
  Dim i As Integer
  Set halb = Sheets("halbs")
  Application.ScreenUpdating = False
  For i = 2 To halb.Cells(Rows.Count, 1).End(xlUp).Row
    For Each ws In ThisWorkbook.Worksheets
      If ws.Name = halb.Cells(i, 1).Value Then GoTo 1
    Next
    Sheets("Muster").Copy after:=ActiveSheet
    With ActiveSheet
      .Name = halb.Cells(i, 1)
      .Range("C5") = halb.Cells(i, 2).Value
      '.Range("P5") = halb.Cells(i, 1).Value 'bzw. Formel
    End With
1:
  Next
  Application.ScreenUpdating = True
End Sub

'bei Bedarf
Sub löschen_aller_numerischer_Blätter()
  Dim ws As Worksheet
  Application.DisplayAlerts = False
  For Each ws In ThisWorkbook.Worksheets
    If IsNumeric(ws.Name) Then ws.Delete
  Next
  Application.DisplayAlerts = True
End Sub

---

lg Nancy         

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Nancy,

läuft SUPER!!!!!

Aus meiner Sicht ist das profimäßig, keine Frage....Kompliment!!
Da werde ich einiges an Klickarbeit einsparen können.
Tausend Dank dafür....

achso.. deine Annahme war richtig "keine Leerzeile" und "nix doppelt".

gruss
Primus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

na oki wenn's klappt,

trotzdem, der 'Schönheit' halber hier noch ohne das hässliche  GoTo,
mein Ideenreichtum stand wohl irgendwie grade auf = False ;-)

lg Nancy
--

Code:

---

Sub ohne_goto()
  Dim ws As Worksheet, halb As Worksheet
  Dim i As Integer, flag As Boolean
  Set halb = Sheets("halbs")
  Application.ScreenUpdating = False
  For i = 2 To halb.Cells(Rows.Count, 1).End(xlUp).Row
    For Each ws In ThisWorkbook.Worksheets
      If ws.Name = halb.Cells(i, 1).Value Then flag = True
    Next
    If Not flag Then
      Sheets("Muster").Copy after:=ActiveSheet
      With ActiveSheet
        .Name = halb.Cells(i, 1)
        .Range("C5") = halb.Cells(i, 2).Value
      End With
    End If
    flag = False
  Next
  Application.ScreenUpdating = True
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Nancy,

vielen Dank für die verbesserte Version,
ein kleiner Fehler ist mir aufgefallen:
Ich habe mal einen "Extremtest" gemacht (mit 700 Halbnummern),
die erste Version ist bei 170 und die zweite Version bei 250 Stück mit einer Fehlermeldung ausgestiegen.(Laufzeitfehler 1004)

Meinst Du das man das in den Griff bekommen könnte?

gruss
Primus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Tja Primus, da bin ich mir jetzt überhaupt nicht sicher.

Ich dächte ich hätt' mal irgenwo was gelesen, dass das von der Anzahl der
zu erstellenden Blätter in einer [neuen] Mappe anhängig sein könnte,
also Extras > Optionen > Allgemein > Blätter in neuer Arbeitsmappe
Ich find's grade nimmer und meine Hand lege ich für diese Aussage auch nicht ins Feuer;-)

Ich hab' da standardmässig 1 drinne, bei mir ist er bei 145 ausgestiegen,
hab's dann mal auf 10 gesetzt, geht aber grade garnix mehr 
müsste ich morgen nochmal an nem andren PC probieren.

Okay, noch am Rande,
wenn Du schon solche Hardcore-Test's machst, diese Seite ist ganz intressant:
http://195.186.84.74/xlimits/limits.htm

lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Nancy,
ich habe gerade mal nachgesehen:

"In einer Standardarbeitsmappe können maximal 255 Blätter enthalten sein."

Ist aber nicht schlimm, mit deiner Hilfe kann ich ja jetzt ein paar Mappen anlegen ohne das ich mir die Finger breche.

Hab nochmals vielen Dank dafür!!!

gruss
Primus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP