Bei Fehler Anweisung durchführen
23.03.2021 13:09:01
Alexandro
ich suche einen Code, dass bei Fehlermeldung mir bestimmte Anweisungen durchführt.
habe
On Error Resume Next ausprobiert
Dim nRow As Integer
For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
Cells(nRow, 3) = "nicht aktuell"
Next nRow
..leider keine Rückmeldung von Excel...Könnte mir dabei jemand helfen?,
freue mich über die Rückmeldung
natürlich ist das nicht gesamte Code...
Option Explicit
Sub Makro1()
'Neues Excel Objekt
Dim objExcel As New Excel.Application
'Sheet Objekt der jeweiligen Exceldatei
Dim objSheet As Object
'Hilfsvariablen
Dim iRow As Integer
Dim strDateipfad As String
Dim strPfad As String
Dim strDateiname As String
'Pfad in welchem sich die Dateien der zu
'kopierenden Zellen sich befinden auswählen
strPfad = "G:bla bla"
'Schleife welche den Zelleninhalt aller aufgelisteten
'Dateien in mehrere Zellen des Hauptprogramms schreibt
On Error Resume Next
Dim nRow As Integer
For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
Cells(nRow, 3) = "keine Verknüpfung"
End If
Next nRow
For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
'(der Arbeitsvorgang wird fortgesetzt)
If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
Exit Sub
Else
strDateiname = Cells(iRow, 2)
strDateipfad = strPfad & strDateiname & ".xlsm"
'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
'(der Arbeitsvorgang wird fotzgesetzt)
If Dir(strDateipfad) = "" Then
Else
objExcel.Workbooks.Open strDateipfad
Set objSheet = objExcel.Sheets("Schnittstelle")
Cells(iRow, 7) = objSheet.Cells(26, 2) ' Cells(Durchsuchte Spalte der Namen, _
Spaltenindex) = objSheets.cells(Zeile,Spalte)
Cells(iRow, 8) = objSheet.Cells(27, 2)
End If
End If
Next iRow
End Sub
Alex