Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1220to1224
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
1220to1224
1220to1224
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA 2007 aus 2003

VBA 2007 aus 2003
Pierre
Hallo zusammen,
ich hatte mir mal irgendwann mühselig im Excel 2003 ein Makro erarbeitet, der mir verschiedene ausgewählte Zellen aus ganz vielen Dateien, die in einem Ordner liegen, in eine Datei zusammenführt. Leider funktioniert das gleiche Makro nicht in 2007. Ich bekomme immer den Fehler 445 angezeigt. Kann mir bitte jemand helfen? Anbei das Makro:
Sub Einfügen()
Dim objWb As Workbook, objSh As Worksheet
Dim intCount As Integer, lngRow As Long
On Error GoTo ErrExit
Call EventsOff
lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1)
With Application.FileSearch
.NewSearch
.LookIn = "C:\Dokumente und Einstellungen\Nedion\Desktop\Praktikum" 'Pfad für Ordner"
.SearchSubFolders = True
.Filename = "*.xls" 'es werden nur xls-intCount aus dem ordner verwendet
If .Execute() > 0 Then
For intCount = 1 To .FoundFiles.Count
If .FoundFiles(intCount) ThisWorkbook.FullName Then
Set objWb = Workbooks.Open(.FoundFiles(intCount)) 'öffnet die Datei
Set objSh = objWb.Sheets("Tabelle1")
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 1) = objSh.Range("E1").Value 'Kunde
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 2) = objSh.Range("E2").Value 'Bauteilbezeichnung
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 3) = objSh.Range("E3").Value 'Ident
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 4) = objSh.Range("B6").Value 'Liefermenge jährlich
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 5) = objSh.Range("B18").Value 'max. Coilgewicht
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 6) = objSh.Range("B20").Value 'i.O.-Platinen pro Coil
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 7) = objSh.Range("B23").Value 'Ladungsträgerart
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 8) = objSh.Range("B37").Value 'Platinen pro LT
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 9) = objSh.Range("B39").Value 'Bruttogewicht LT
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 10) = objSh.Range("E5").Value 'Arbeitsstation
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 11) = objSh.Range("E9").Value 'Platinen pro Hub
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 12) = objSh.Range("E10").Value 'Hub je Minute
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 13) = objSh.Range("E23").Value 'LT pro LKW
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 14) = objSh.Range("E24").Value 'Platinen pro LKW
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 15) = objSh.Range("B34").Value 'Anzahl LT
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 16) = objSh.Range("F28").Value 'SB
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 17) = objSh.Range("I28").Value 'Lagerfläche SB
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 18) = objSh.Range("I9").Value 'Rüstvorgänge
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 19) = objSh.Range("I10").Value 'Coils pr Los
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 20) = objSh.Range("I11").Value 'Stückzahl pro Los
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 21) = objSh.Range("I12").Value 'LT pro Los
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 22) = objSh.Range("I14").Value 'LT gesamt
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 23) = objSh.Range("I22").Value 'Hübe je Los
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 24) = objSh.Range("I25").Value 'Poduktionsdauer
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 25) = objSh.Range("I16").Value 'Lagerkosten Lose
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 26) = objSh.Range("I17").Value 'Lagerkosten SB
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 27) = objSh.Range("I18").Value 'Rüstkosten
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 28) = objSh.Range("I19").Value 'LT-Kosten
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 29) = objSh.Range("I20").Value 'Gesamtkosten
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 30) = objSh.Range("I34").Value 'g Fläche
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, 31) = objSh.Range("I37").Value 'ü Fläche
Set objSh = Nothing
objWb.Close False 'schließt die Datei
lngRow = lngRow + 1
End If
Next
End If
End With
ErrExit:
If Err.Number 0 Then
MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
End If
Call EventsOn
Set objSh = Nothing
Set objWb = Nothing
End Sub 


Public Sub EventsOff()

With Application

.ScreenUpdating = False

.EnableEvents = False

.Calculation = xlCalculationManual

End With

End Sub



Public Sub EventsOn()

With Application

.ScreenUpdating = True

.EnableEvents = True

.Calculation = xlCalculationAutomatic

End With

End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA 2007 aus 2003
11.07.2011 13:33:49
mumpel
Hallo!
Bitte bemühe die Forensuche. "Application.FileSearch" gibt es ab Office 2007 nicht mehr.
auch auf http://www.office-loesung.de findest Du zahlreiche Alternativen.
Gruß, René
AW: VBA 2007 aus 2003
11.07.2011 15:17:53
Pierre
Hallo nochmal!
Ich habe mir das angeschaut und schaffe es ehrlich gesagt nicht das Makro umzuschreiben. Ist schon etwas her, dass ich das mal erstellt habe. Wäre vielleicht jemand so lieb mir das eben umzuschreiben? Brauche es nämlich dringend! Ich habe auch noch ein altes Makro gefunden, was viel kürzer ist. Danke im voraus!
Sub Einfügen()
Dim objWb As Workbook
Dim intCount As Integer, lngRow As Long
Dim vntC As Variant, lngCol As Long
Const strCells As String = _
"E1,E2,E3,B6,B18,B20,B23,B37,B39,E5,E9,E10,E23,E24,B34,F28,I28,I9,I10,I11,I12,I14,I22,I25,I16,I17,I18,I19,I20,I34,I37,J9,J10,J11,J12,J14,J22,J25,J16,J17,J18,J19,J20,J34,J37,K9,K10,K11,K12,K14,K22,K25,K16,K17,K18,K19,K20,K34,K37"
On Error GoTo ErrExit
Call EventsOff
lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1)
vntC = Split(strCells, ",")
With Application.FileSearch
.NewSearch
.LookIn = "C:\Praktikum"
.SearchSubFolders = True
.Filename = "*.xls" 'es werden nur xls-intCount aus dem ordner verwendet
If .Execute() > 0 Then
For intCount = 1 To .FoundFiles.Count
If .FoundFiles(intCount) ThisWorkbook.FullName Then
Set objWb = Workbooks.Open(.FoundFiles(intCount)) 'öffnet die Datei
For lngCol = 1 To UBound(vntC) + 1
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, lngCol) = objWb.Sheets("Tabelle1").Range(vntC(lngCol - 1)).Value
Next
objWb.Close False 'schließt die Datei
lngRow = lngRow + 1
End If
Next
End If
End With
ErrExit:
If Err.Number 0 Then
MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
End If
Call EventsOn
Set objWb = Nothing
End Sub 
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
AW: VBA 2007 aus 2003
11.07.2011 16:40:55
Rudi
Hallo,
durchsucht aber keinen Unterordner: 
Sub Einfügen()
Dim objWb As Workbook
Dim intCount As Integer, lngRow As Long
Dim vntC As Variant, lngCol As Long, sFile As String
Const sPfad As String = "c:\Praktikum\"
Const strCells As String = _
"E1,E2,E3,B6,B18,B20,B23,B37,B39,E5,E9,E10," _
& "E23,E24,B34,F28,I28,I9,I10,I11,I12,I14,I22," _
& "I25,I16,I17,I18,I19,I20,I34,I37,J9,J10,J11," _
& "J12,J14,J22,J25,J16,J17,J18,J19,J20,J34,J37," _
& "K9,K10,K11,K12,K14,K22,K25,K16,K17,K18,K19,K20,K34,K37"
On Error GoTo ErrExit
Call EventsOff
lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + _
1)
vntC = Split(strCells, ",")
sFile = Dir(sPfad & "*.xls")
Do While sFile  ""
If sFile  ThisWorkbook.Name Then
Set objWb = Workbooks.Open(sPfad & sFile) 'öffnet die Datei
For lngCol = 1 To UBound(vntC) + 1
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, lngCol) = objWb.Sheets("Tabelle1").Range(vntC( _
lngCol - 1)).Value
Next
objWb.Close False 'schließt die Datei
lngRow = lngRow + 1
End If
sFile = Dir
Loop
ErrExit:
If Err.Number  0 Then
MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
End If
Call EventsOn
Set objWb = Nothing
End Sub

Gruß
Rudi
Anzeige
AW: VBA 2007 aus 2003
11.07.2011 17:32:04
Pierre
Hallo Rudi, danke für die Hilfe erst einmal. Habe das Makro eingefügt, aber wenn ich das Makro ausführe, zeigt er mir die Fehler bei "Call EventsOff" und bei "Call EventsOn" an.. Woran kann das liegen?
Woran kann das liegen?
12.07.2011 09:06:29
Rudi
Hallo,
daran, dass die beiden Prozeduren nicht in deiner Mappe vorhanden sind.
Gruß
Rudi
AW: VBA 2007 aus 2003
11.07.2011 17:02:44
Hajo_Zi
Hallo Piere,
die verlinkte Datei gefällt Dir also nicht?
Gruß Hajo
AW: VBA 2007 aus 2003
11.07.2011 18:18:15
Pierre
Hallo Hajo,
ehrlich gesagt bekomme ich es nicht hin, die verlinkte Datei auf mein Problem zu übertragen. Bin halt nicht mehr so fit im VBA.. Im 2003 hatte ich alles mal wunderbar hinbekommen, aber im 2007 blicke ich momentan nicht durch.
Ich wäre froh, wenn mir jemand helfen kann. Das Makro soll nur die die Werte aus den Zellen in eine neue Datei übertragen. Ich habe ca. 100 Dateien in einem Ordner, die gleich aufgebaut sind. Aus denen sollen die knapp 60 Werte gewählt und nebeneinander in eine Datei gezogen werden. Also die Werte aus einer Datei sollen nebeneinander in einer Zeile stehen, und die gleichen Werte aus den unterschiedlichen Dateien in einer Spalte untereinander..
Bin weiterhin für Ratschläge offen, denn immerhin hat das ja mal geklappt.. Vielleicht gibt es ja jemanden, der sich das alte Makro anschauen und mal eben fürs 2007 umändern kann?! Das wäre super!
Anzeige
AW: VBA 2007 aus 2003
11.07.2011 18:22:47
Hajo_Zi
Den Code für das übertragen hast du doch schon. Du brauchst doch nur dort wo die Daten in die Tabelle geschrieben wird, Deinen Code einfügen.
Ich bin nur an einem Not PC da ist mir das zu aufwendig.
Gruß Hajo

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige