Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler im Code
 06.06.2011 09:12:36 safari
NotSolved
24.06.2011 21:45:33 Dekor
NotSolved

Ansicht des Beitrags:
Von:
safari		 Datum:
06.06.2011 09:12:36		 Views:
1565		 Rating:
     
Antwort:
  Ja
Thema:
Fehler im Code
Hallo Zusammen, Wiedermal habe ich eine Frage, ich habe einen Code geschrieben mit welchem Ich aus einem Ordner mehrere Dateien auswählen kann und diese danach in meine Liste einlesen kann. Leider ist dort ein Fehler End With ohne With. Ich finde den Fehler einfach nicht, was muss ich am Code ändern? Hier der Code: 'Daten einlesen Private Sub CommandButton1_Click() Dim filSRC As Excel.Workbook Dim vntSRC As Variant Dim shtTRG As Excel.Worksheet Dim rngSearch As Excel.Range Dim rngZelle As Excel.Range Dim lngFreieZeile As Long Dim bolExist As Boolean Dim iFiles As Long On Error Resume Next Application.ScreenUpdating = False Application.EnableEvents = False Set shtTRG = ThisWorkbook.Sheets("3_Machbarkeit") With shtTRG lngFreieZeile = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row + 1 vntSRC = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls),*.xls,Excel2007-Arbeitsmappe (*.xlsx),*.xlsx", 1, "Importdatei(n) auswählen...", "Importdatei", True) If IsArray(vntSRC) = True Then For iFiles = 1 To UBound(vntSRC) Set filSRC = Application.Workbooks.Open(vntSRC(iFiles), , True): DoEvents ' Set rngSearch = .Range("D1:" & CStr(lngFreieZeile - 1)) bolExist = False For Each rngZelle In shtTRG.Range("D1:D150") If rngZelle.Value = filSRC.Sheets(1).Range("D1").Value Then rngZelle.EntireRow.Columns("B") = filSRC.Sheets(1).Range("B1") rngZelle.EntireRow.Columns("C") = filSRC.Sheets(1).Range("B1") rngZelle.EntireRow.Columns("D") = filSRC.Sheets(1).Range("D1") rngZelle.EntireRow.Columns("E") = filSRC.Sheets(1).Range("B2") rngZelle.EntireRow.Columns("F") = filSRC.Sheets(1).Range("D2") bolExist = True Exit For End If Next rngZelle If bolExist = False Then .Cells(lngFreieZeile, "B") = filSRC.Sheets(1).Range("B1") .Cells(lngFreieZeile, "C") = filSRC.Sheets(1).Range("B1") .Cells(lngFreieZeile, "D") = filSRC.Sheets(1).Range("D1") .Cells(lngFreieZeile, "E") = filSRC.Sheets(1).Range("B2") .Cells(lngFreieZeile, "F") = filSRC.Sheets(1).Range("D2") End If filSRC.Close False Set filSRC = Nothing Set rngSearch = Nothing Next iFiles End If End With Set shtTRG = Nothing Application.ScreenUpdating = True Application.EnableEvents = True End Sub Gruss Reto

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler im Code
 06.06.2011 09:12:36 safari
NotSolved
24.06.2011 21:45:33 Dekor
NotSolved