Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Hilfe bei Excel-Makro mit Fehler - Arbeitsblätter autom. erstellen und ausfüllen

Frage Entwicklung VB for Applications

Mitglied: krm5000

krm5000 (Level 1) - Jetzt verbinden

30.11.2012 um 16:02 Uhr, 3771 Aufrufe, 5 Kommentare

Hallo,

ich bin Anfänger was VBA angeht und habe auch sonst wenig Programmierkenntnisse, deswegen habe ich ein Makro, das eigentlich funktionieren müsste, es aber nicht tut..

Ich habe eine Excel Arbeitsmappe in der in Spalte J Namen stehen zwischen den Namen sind leere Zellen.
Das Makro soll:
1. für jede Zelle in Spalte J in der etwas steht ein neues Arbeitsblatt machen.
2. Jedes Arbeitsblatt bekommt als Namen das was in der jeweiligen Zelle in Spalte J steht.
3. Die erste Zeile der Arbeitsmappe soll ins neue Arbeitsblatt kopiert werden.
4. Außerdem sollen bestimmte Zellen in Spalte A bis G ins neue Arbeitsblatt kopiert werden. Das sind die Zellen ab der jeweiligen Zelle in Spalte J bis zu der Zeile in der wieder etwas steht.

Beispiel: in Zelle J2 steht "Haus", Zellen J3 bis J5 sind leer, in J6 steht "Ball"
erzeugt wird ein Arbeitsblatt mit Namen "Haus"
Die erste Zeile wird kopiert
Der Bereich A2 bis G5 wird kopiert (<-- hier ist der Fehler)

Dafür habe ich bereits ein anderes Makro umgeschrieben:

Option Explicit

Sub BlaetterAusLagerliste()
Dim rngMuster As Range, rngDaten As Range, zz As Long, ss As Long, aa As Long, bb As Long

Set rngMuster = Sheets("Lagerliste_1002_1340_201211").Rows(1) '1. Zeile speichern
aa = 1
bb = 1

With Sheets("Lagerliste_1002_1340_201211")
For zz = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For ss = 1 To Sheets.Count
If Sheets(ss).Name = CStr(.Cells(zz, 1)) Then
'Kontrolle ob Arbeitsblatt mit dem Namen bereits existiert
MsgBox "Blatt '" & .Cells(zz, 10) & "' bereits vorhanden.", vbInformation 'X
Exit For
End If
Next ss
aa = aa + 1
'aa: aktuelle Zelle
If bb < aa Then
bb = aa
End If
Hier:
If Worksheets("Lagerliste_1002_1340_201211").Cells(bb + 1, 10) = Empty Then
'bb: immer letzte leere Zelle
bb = bb + 1
GoTo Hier
End If
Set rngDaten = Worksheets("Lagerliste_1002_1340_201211").Range(Cells(aa, 1), Cells(bb, 7)) 'XXXXXXXX
'zugehörige Zellen speichern
If ss > Sheets.Count And Not Worksheets("Lagerliste_1002_1340_201211").Cells(aa, 10) = Empty Then 'kein neues Blatt falls leer
Worksheets.Add after:=Sheets(Sheets.Count) 'Erstellt neues Arbeitsblatt
rngMuster.Copy Cells(1, 1) 'Kopiert 1. Zeile ins n. Arbeitsblatt
rngDaten.Copy Cells(2, 1) 'Kopiert zugehörige Zellen ins n. Arbeitsblatt
Cells(2, 10) = .Cells(zz, 10) 'Kopiert J2 ins neue Jzz
ActiveSheet.Name = CStr(Cells(2, 10)) 'Umbenennen nach J2
End If
Next zz
End With
End Sub


Der Fehler kommt da wo XXXXXXXX steht. Das ist die Funktion, die die zu kopierende Zellen speichern soll (unter 4. erklärt).
Fehler: Laufzeitfehler '1004'
Anwendungs oder objektdefinierter Fehler.

Ich hoffe es ist alles verständlich. Benutzt wird Office 2003.
Mitglied: 76109
01.12.2012, aktualisiert um 11:31 Uhr
Hallo krm5000!

Du hast zu Begin das hier stehen
01.
With Sheets("Lagerliste_1002_1340_201211")
Insofern genügt:
01.
Set rngDaten = .Range(.Cells(aa, 1), .Cells(bb, 7))
wobei sich eigentlich nur die Cells-Angaben auf das Sheet beziehen müssen. Je nach Excel-Version will aber auch das Range ein Pünktchen haben wollen.

Ist die Anzahl der Leerzeilen in Spalte J bzw. die Anzahl der Kopierzeilen Spalte A:G immer gleich?

Um den Code lesbarer zu machen, solltest Du dir mal die Formatierungshilfe ansehen und Deinen Code in Code-Tags setzen

Gruß Dieter
Bitte warten ..
Mitglied: Friemler
01.12.2012, aktualisiert um 17:03 Uhr
Hallo krm5000,

das hier sollte funktionieren:
01.
Option Explicit 
02.
 
03.
 
04.
Sub BlaetterAusLagerliste() 
05.
  Dim intLine As Long, intMaxLine As Long, intStartLine As Long, intEndLine As Long, intSheetNo As Long 
06.
  Dim rngMuster As Range, rngDaten As Range 
07.
  Dim strWorkSheet As String 
08.
   
09.
  strWorkSheet = "Lagerliste_1002_1340_201211" 
10.
   
11.
  With Sheets(strWorkSheet) 
12.
    Set rngMuster = .Rows(1) 
13.
    intMaxLine = .Cells(.Rows.Count, 1).End(xlUp).Row 
14.
     
15.
    For intLine = 2 To intMaxLine 
16.
      'Kontrolle ob Arbeitsblatt mit dem aktuellen Namen bereits existiert 
17.
      For intSheetNo = 1 To Sheets.Count 
18.
        If Sheets(intSheetNo).Name = CStr(.Cells(intLine, 10)) Then 
19.
          MsgBox "Blatt '" & .Cells(intLine, 10) & "' bereits vorhanden.", vbInformation 
20.
          Exit For 
21.
        End If 
22.
      Next intSheetNo 
23.
       
24.
      intStartLine = intLine 
25.
      intEndLine = intLine 
26.
       
27.
      'letzte Zeile suchen, die zum aktuellen Namen gehört 
28.
      While Worksheets(strWorkSheet).Cells(intEndLine + 1, 10) = Empty And intEndLine < intMaxLine 
29.
        intEndLine = intEndLine + 1 
30.
      Wend 
31.
       
32.
      Set rngDaten = Worksheets(strWorkSheet).Range(Cells(intStartLine, 1), Cells(intEndLine, 7)) 
33.
       
34.
      'Wenn noch kein Arbeitsblatt mit dem aktuellen Namen existiert die zugehörigen Zellen speichern 
35.
      If intSheetNo > Sheets.Count Then 
36.
        Worksheets.Add after:=Sheets(Sheets.Count)          'Erstellt neues Arbeitsblatt 
37.
        ActiveSheet.Name = CStr(.Cells(intStartLine, 10))   'Umbenennen auf den aktuellen Namen 
38.
        ActiveSheet.Cells(2, 10) = .Cells(intStartLine, 10) 'Kopiert den aktuellen Namen 
39.
        rngMuster.Copy ActiveSheet.Cells(1, 1)              'Kopiert 1. Zeile ins neue Arbeitsblatt 
40.
        rngDaten.Copy ActiveSheet.Cells(2, 1)               'Kopiert zugehörige Zellen ins neue Arbeitsblatt 
41.
      End If 
42.
       
43.
      intLine = intEndLine 
44.
    Next intLine 
45.
  End With 
46.
End Sub
Dein Quellcode enthält verschiedene kleine Fehler. Der entscheidende war aber wohl, dass ein Äquivalent zu And intEndLine < intMaxLine bei der Abbruchbedingung der Suchschleife in den Zeilen 20 bis 22 gefehlt hat.

Gruß
Friemler
Bitte warten ..
Mitglied: 76109
01.12.2012, aktualisiert um 10:42 Uhr
Hallo Friemler!

Na, dann biete ich doch auch Gleich eine Lösung mit an

01.
Option Explicit 
02.
 
03.
Private Const RowsStart = 2 
04.
 
05.
Sub BlaetterAusLagerliste() 
06.
    Dim Wks As Worksheet, Cell As Range, RowsEnd As Long, RowsCopyEnd As Long 
07.
 
08.
    With Sheets("Lagerliste_1002_1340_201211") 
09.
        RowsEnd = .Cells(.Rows.Count, "A").End(xlUp).Row    'Letzte Zeile in Spalte A 
10.
         
11.
        For Each Cell In .Range(.Cells(RowsStart, "J"), .Cells(RowsEnd, "J"))   'Alle Zellen in Spalte J 
12.
            If Cell.Text <> "" Then     'Test Zelle nicht Leer 
13.
                Set Wks = Nothing       'Sheet Is Nothing 
14.
                 
15.
                'Fehlerbehandlung Aus, Set Sheet, Fehlerbehandlung wieder Ein 
16.
                On Error Resume Next:  Set Wks = Sheets(Cell.Text):  On Error GoTo 0 
17.
                 
18.
                If Wks Is Nothing Then  'Test Sheet noch nicht vorhanden 
19.
                    Worksheets.Add After:=Sheets(Sheets.Count) 'Erstellt neues Arbeitsblatt 
20.
                    ActiveSheet.Name = Cell.Text    'Sheetnamen vergeben 
21.
                    RowsCopyEnd = Cell.End(xlDown).Row - 1  'Nächste Zeile mit Inhalt - 1 
22.
                    If RowsCopyEnd > RowsEnd Then RowsCopyEnd = RowsEnd 'Test Ende erreicht 
23.
                   .Rows(1).Copy Rows(1)    'Kopie Zeile 1 und Zellen Spalte A:G 
24.
                   .Range(.Cells(Cell.Row, "A"), .Cells(RowsCopyEnd, "G")).Copy Cells(RowsStart, "A") 
25.
                Else 
26.
                    MsgBox "Blatt '" & Cell.Text & "' bereits vorhanden.", vbInformation, "Hinweis..." 
27.
                End If 
28.
            End If 
29.
        Next 
30.
    End With 
31.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: krm5000
01.12.2012 um 15:29 Uhr
Vielen Dank für die Antworten, werde die Lösungen gleich am Montag als erstes testen. Melde mich dann wieder.
Bitte warten ..
Mitglied: krm5000
03.12.2012, aktualisiert um 10:23 Uhr
Es funktioniert ;) Soweit ich das beurteilen kann funktionieren alle 3 Lösungen (Anpassungen sind möglicherweise nötig). Benutze jetzt erst mal die erste Lösung von Dieter wo ich nur die eine Zeile ändern musste. Ich muss am Makro noch arbeiten weil da wohl noch was anderes mitkopiert werden soll. Vielen Dank für die Tipps und Lösungen.

Ich hätte noch eine kleine Frage zu Excel (Glaube ein Neues Thema zu erstellen ist nicht nötig):
Wenn ich zb mit der Funktion: =WENN(ZÄHLENWENN($A$2:$A$9456;Mappe2!E4)=0;"nicht vorhanden";"vorhanden")
auf eine andere Exceldatei verweisen möchte, muss diese Datei dann unbedingt gespeichert worden sein (und nicht einfach nur offen)?

Das sind nämlich Dateien mit denen verschiedene Werte/Konfigurationen von einem CAD-Programm gesteuert werden. Sie werden vom Programm generiert und nicht als Exceldatei abgespeichert.

//EDIT: Ich ziehe meine Frage zurück.. Es klappt doch ohne zu speichern. Keine Ahnung wieso er vorhin nicht wollte.
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
gelöst Microsoft Office Makro-Fehler unterdrücken (3)

Frage von Akrosh zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel-Makro (7)

Frage von yuki13 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel Makro : Erst prüfen bei erfolgreicher IF einen Wert überschreiben (4)

Frage von Matze1508 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel Makro - Button "Springe zu Zeile mit heutigem Datum" (5)

Frage von hannsgmaulwurf zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (20)

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...