Thema Datum  Von Nutzer Rating
Antwort
Rot VBA: Code soll Zellen Löschen und eine Range überschreiben
25.06.2020 12:01:11 Max
NotSolved
25.06.2020 12:27:18 Mase
NotSolved
25.06.2020 19:42:23 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Max
Datum:
25.06.2020 12:01:11
Views:
1288
Rating: Antwort:
  Ja
Thema:
VBA: Code soll Zellen Löschen und eine Range überschreiben

Hallo ihr, 

ich habe einen Scipt geschriebe, welche mir aus einem Ausgeblendeten Sheet zwei Reihen löschen soll, das diese in einem Dropdown nicht mehr gebraucht werden. Hierzu wird das Sheet erst eingeblendet nach dem Löschen wieder ausgeblendet. 

Zudem soll auf allen andern Sheets der Datei die Legende überschrieben werden, da diese beiden vorher im Dropdown gelöschten Einträge nicht mehr in der Legende vorkommen sollen. 

Hierfür scheide ich einfach ein Range aus und überschreib die nicht gebrauchten Einträge der Legende.

Dies soll für alle Dateien in einem Ordner automatisch geschehen. Die Dateien liegen in einem OneDrive Ordner, welche in den WindowsExplorer integriert wurde, damit ich per VBA daruf zugreifen kann.

Nun zu meinem Fehler, in meinem Code (hänge ich unten an) spreche ich immer nur von Zeile 4 und 5. Jedoch geht das Script hin und löscht mir Iden kompletten Inhalt  aus Zeile 11 und höher (12,13,15, etc.) raus. 

Diese Fehler passiert jedoch auch nicht in allen Datein sondern nur bei 60% die anderen 40% sind richtig. Ich habe die Datein überprüft und deren Aufbau ist 1:1 der selbe.

 

Hier nun der Code:

Sub Zeilen_Löschen()
 
Dim cDir As String
Dim sPath As String
Dim AnzahlSheets
   
sPath = "hier steht der Pfad wo Die Dateien abliegen"
cDir = Dir(sPath & "*.xls")
 
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
   
Do While cDir <> ""
 
    Workbooks.Open (sPath & cDir)
    
    Worksheets("Dropdowns").Visible = True
    
    Worksheets("Dropdowns").Rows(5).Delete
    Worksheets("Dropdowns").Rows(5).Delete
    
    Worksheets("Dropdowns").Visible = False
    
    AnzahlSheets = (ActiveWorkbook.Worksheets.Count) - 1
    
'Hier wird die Legende überschrieben
    For i = 2 To AnzahlSheets
    
        Worksheets(i).Range("U4:AC4").Cut _
            Destination:=Worksheets(i).Range("Q4")
            
        Worksheets(i).Range("Z4:AC4").Clear
    
    Next
    
 
    'ActiveWorkbook.SaveAs sPath & cDir
    ActiveWorkbook.Close False
       
    'nächste Datei lesen
    cDir = Dir
    
Loop
 
'Kleine finale Fertig-Meldung
MsgBox "Zeilen gelöscht!"
 
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
    
End Sub

Könnt ihr mir vielleicht sagen wo wo hier der Fehler liegt oder was ich falsch mache?? 

 

Grüße

Max


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 VBA: Code soll Zellen Löschen und eine Range überschreiben
25.06.2020 12:01:11 Max
NotSolved
25.06.2020 12:27:18 Mase
NotSolved
25.06.2020 19:42:23 ralf_b
NotSolved