PDA

Vollständige Version anzeigen : Makro funktioniert nicht!


yves65
08.09.2011, 17:27
Hilfe mein Makro funktioniert nicht
es kommt immer der Befehl Debuggen an der rot markierten Stelle.
Kann mir jemand sagen, weshalb?

Herzlichen Dank für die Hilfe!

Herbstliche Grüsse aus der Schweiz


Sub Zusammenzug()
Application.ScreenUpdating = False
Dim MySheet As Worksheet ' aktuelles Arbeitsblatt
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer
Application.DisplayAlerts = False

delta = 0
Set meins = ActiveWorkbook
Set MySheet = meins.ActiveSheet
strPath = ActiveWorkbook.Path & "\"

'-------------------------------------'
' Verzeichnis durchgehen und alle Dateien auslesen '-------------------------------------'
strFile = Dir(strPath & "\" & "*.xls")
Do While strFile <> "" ' Schleife beginnen

If strFile = ActiveWorkbook.Name Then
'-------------------------------------------------'
' Datei übergehen
'-------------------------------------------------'
Else


'-------------------------------------'
' Quelldatei öffnen
' und 1. Registerblatt auswählen
'-------------------------------------'
Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
Set wksInput = wkbInput.Worksheets("Bewerber")

'-------------------------------------'
' Daten auslesen und in Auswertung kopieren
'-------------------------------------'

' kopieren Bewerberfiles
wksInput.Activate
wksInput.Select
Rows("3:50").Select
Selection.Copy
meins.Activate
MySheet.Activate
MySheet.Cells(4, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False

Rows("3:52").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow


'-------------------------------------'
' Datei schließen
'-------------------------------------'

wkbInput.Close 'Workbook schliessen

Set wksInput = Nothing

End If


Set MySheet = Nothing
Set meins = Nothing

strFile = Dir ' Nächsten Eintrag abrufen

Loop

Application.ScreenUpdating = True


MsgBox "Abgeschlossen"

End Sub

EarlFred
08.09.2011, 18:45
Hallo (Name),

Hilfe mein Makro funktioniert nicht
Guter, alles erklärender Einstieg - ich bin sofort im Bilde ;)

es kommt immer der Befehl Debuggen an der rot markierten Stelle.
Dazu kommt auch immer eine Fehlermeldung (Nummer + Beschreibung). Diese bitte auch immer mit angeben, damit die Fehlersuche einfacher wird!
In Deinem Fall die 91 "Objektvariable oder With-Blockvariable nicht festgelegt."

Ein Tipp zu
Application.DisplayAlerts = False
Geh sparsam damit um, setze es nur vor die Zeilen, bei denen Du wirklich sicher bist, dass Du die Warnungen ausstellen willst und schalte sie danach sofort wieder an....
Hast Du das wegen wkbInput.Close gesetzt? Nutze doch das Argument SaveChanges:=False stattdessen.
Apropos:
Dim wkbInput, meins As Workbook '
damit deklarierst Du eine Variable (meins) als Workbook, die andere (wkbInput) als Variant. Immer bei jeder Variable den Typ angeben.



Warum selectest und activetest Du überhaupt, wenn Du doch sauber die vorhandenen Objektvariablen nutzen kannst?
wksInput.Activate
wksInput.Select
Sicher ist sicher? ;)


If strFile = ActiveWorkbook.Name Then
'-------------------------------------------------'
' Datei übergehen
'-------------------------------------------------'
Else
...
End If

Warum nicht auf "<>" testen und den Code vom Else(Falsch)-Teil in den "Wahr"-Teil verschieben? Ist sonst unübersichtlich.


Eine saubere Einrückung im Code (i. d. R. zusammengehörende Blöcke auf einer Tab-Ebene) liest sich allemal besser (man erkennt sofort, was wohin gehört) als "linksandenrandgeklatschter" Code.
Do While ....
If .... Then
tu was
Else
meins.Activate
End If
Set meins = Nothing <----- !!!
Loop

Zur eigentlichen Frage:
Set meins = Nothing
...kommt bei Dir innerhalb der Do-Loop-Schleife. Beim 2. Durchlauf ist meins also = Nothing. Du kannst Nothing weder selecten noch activaten.

Setze den Befehl einfach hinter die Schleife.

Grüße
EarlFred

yves65
09.09.2011, 10:53
Herzlichen Dank für die professionelle Antwort, obwohl ich nicht alles verstanden habe. Aber das liegt an meinem beschränkten Wissen.
Habe das Makro wie folgt angepasst, es läuft nun ohne Fehlermeldung durch, aber es passiert auch nichts weiter. Woran könnte das liegen?

Sub Zusammenzug()

Dim MySheet As Worksheet ' aktuelles Arbeitsblatt
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer
Application.DisplayAlerts = False

delta = 0
Set meins = ActiveWorkbook
Set MySheet = meins.ActiveSheet
strPath = ActiveWorkbook.Path & "\"

'-------------------------------------'
' Verzeichnis durchgehen und alle Dateien auslesen
strFile = Dir(strPath & "\" & "*.xls")
Do While strFile <> "" ' Schleife beginnen


' Datei übergehen
'-------------------------------------------------'
If strFile = ActiveWorkbook.Name Then

Else

'-------------------------------------'
' Quelldatei öffnen
' und 1. Registerblatt auswählen
'-------------------------------------'
Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
Set wksInput = wkbInput.Worksheets("Bewerber")

'-------------------------------------'
' Daten auslesen und in Auswertung kopieren
'-------------------------------------'

' kopieren Bewerberfiles
wksInput.Activate
wksInput.Select
Rows("3:50").Select
Selection.Copy
meins.Activate
MySheet.Activate
MySheet.Cells(3, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False

Rows("3:5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

'-------------------------------------'
' Datei schließen
'-------------------------------------'

wkbInput.Close 'Workbook schliessen

Set wksInput = Nothing

End If

strFile = Dir ' Nächsten Eintrag abrufen

Loop


Set MySheet = Nothing
Set meins = Nothing

Application.ScreenUpdating = True


MsgBox "Abgeschlossen"

End Sub

Hasso
09.09.2011, 15:27
Hallo yves65,

es läuft nun ohne Fehlermeldung durch, aber es passiert auch nichts weiter
Was sollte denn passieren?

Hier mein immer wieder gerne gegebener Tipp: Das Hochladen einer Beispieldatei erhöhtdie Aussicht auf eine hilfreiche Antwort ungemein!

yves65
13.09.2011, 14:53
Hallo Hasso
Das Makro sollte aus allen Excel Dateien im Ordnerund allen Unterordner die Zeilen 3-50 rauskopieren und in die Datei kopieren. Am Ende soll mit dem Makro eine Sortierung gemacht werden, damit alle Zeilen, in denen nichts steht, ganz unten stehen.