Top-Themen

Aktuelle Themen (A bis Z)

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, 3867 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 ..
Ähnliche Inhalte
Visual Studio
Excel 2010 Hilfe bei Makro
gelöst Frage von IceAgeVisual Studio8 Kommentare

Hallo Liebe Adminstratoren, ich bräuchte mal eure Unterstützung bei einem Excel Makro. Ich habe eine Excelliste mit 2 Tabellen. ...

Microsoft Office
Excel Makro PDF erstellen
Frage von Chrigi83Microsoft Office1 Kommentar

Hallo zusammen Hab ein kleines Projekt in dem ich gerne ein PDF aus einem Excel drucken möchte mit dem ...

Microsoft Office
MAKRO EXCEL bestimmten Zahlen von einem Arbeitsblatt X in ein neues Arbeitsblatt Z kopieren
gelöst Frage von user2k14Microsoft Office8 Kommentare

hallo, ich möchte gerne ein Makro erstellen, welches mir ein bestimmtes Wort sucht, dieses Wort kommt immer vor in ...

Microsoft Office
Excel Arbeitsblätter kopieren sich selbstständig
gelöst Frage von KMP1988Microsoft Office7 Kommentare

Servus, ich habe ein Problem mit Excel 2013. Ein Kunde hat bei sich am PC eine Excel-Datei mit mehreren ...

Neue Wissensbeiträge
Verschlüsselung & Zertifikate

Die Hölle friert ein weiteres Stück zu: Microsoft integriert OpenSSH in Windows

Information von ticuta1 vor 2 StundenVerschlüsselung & Zertifikate

Interessant SSH-Kommando in CMD.exe und PowerShell

Apple

IOS 11.2.1 stopft HomeKit-Remote-Lücke

Tipp von BassFishFox vor 1 TagApple

Das Update für iPhone, iPad und Apple TV soll die Fernsteuerung von Smart-Home-Geräten wieder in vollem Umfang ermöglichen. Apple ...

Windows 10

Windows 10 v1709 EN murkst bei den Regionseinstellungen

Tipp von DerWoWusste vor 1 TagWindows 10

Dieser kurze Tipp richtet sich an den kleinen Personenkreis, der Win10 v1709 EN-US frisch installiert und dabei die englische ...

Webbrowser

Kein Ton bei Firefox Quantum über RDP

Tipp von Moddry vor 1 TagWebbrowser

Hallo Kollegen! Hatte das Problem, dass der neue Firefox bei mir auf der Kiste keinen Ton hat, wenn ich ...

Heiß diskutierte Inhalte
Windows Server
RODC kann nicht aus Domäne entfernt werden
Frage von NilsvLehnWindows Server19 Kommentare

HAllo, ich arbeite in einem Universitätsnetzwerk mit 3 Standorten. Die Standorte haben alle ein ESXi Cluster und auf diesen ...

Hardware
Kein Bild mit nur einer bestimmten Grafikkarten - Mainboard Konfiguration
gelöst Frage von bestelittHardware18 Kommentare

Hallo zusammen, ich hatte schon einmal eine ähnliche Frage gestellt. Damals hatte ich genau das gleiche Problem. Allerdings lies ...

Netzwerkmanagement
Mehrere Netzwerkadapter in einem PC zu einem Switch zusammenfügen
Frage von prodriveNetzwerkmanagement17 Kommentare

Hallo zusammen Vorweg, ich konnte schon einige IT-Probleme mit Hilfe dieses Forums lösen. Wirklich klasse hier! Doch für das ...

Hardware
Links klick bei Maus funktioniert nicht
gelöst Frage von Pablu23Hardware16 Kommentare

Hallo erstmal. Ich habe ein Problem mit meiner relativ alten maus jedoch denke ich nicht das es an der ...