Thema Datum  Von Nutzer Rating
Antwort
07.09.2020 17:23:52 Gast52733
NotSolved
Blau Makro wählt nicht das nächste Sheet
 07.09.2020 18:39:00 Werner
Solved
08.09.2020 08:02:15 Gast96552
NotSolved

Ansicht des Beitrags:
Von:
Werner		 Datum:
07.09.2020 18:39:00		 Views:
702		 Rating:
     
Antwort:
 Nein
Thema:
Makro wählt nicht das nächste Sheet

Hallo,

ungetestet:

Sub Aufbereitung()
Dim cDir As String, sPath As String, i As Long
Dim wbQuelle As Workbook, ws As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
        
sPath = ThisWorkbook.Path & "\verarbeiten\"
cDir = Dir(sPath & "*.xlsm")

Do While cDir <> ""
    Set wbQuelle = Workbooks.Open(sPath & cDir)
    With wbQuelle
        .Worksheets("Übersicht").Delete
        .Worksheets("BEZ").Delete
        For Each ws In .Worksheets
            With ws
                .Unprotect "controlling2020"
                .Cells.Copy
                .Cells.PasteSpecial Paste:=xlPasteValues
                If .Range("M173") <> 0 Then
                    .Outline.ShowLevels RowLevels:=2
                    .Cells.Rows.Ungroup
                    For i = 2 To 12
                        .Cells(8, i) = "Spalte " & Split(.Cells(8, i).Address, "$")(1)
                    Next i
                    .Range("$A:$M").AutoFilter Field:=13, Criteria1:="<>0", Operator:=xlFilterValues
                    .Range("$A:$M").AutoFilter Field:=2, Criteria1:="<>"
                    .Columns("D:L").Delete Shift:=xlToLeft
                    .Columns("B:B").Insert Shift:=xlToRight
                    .Range("B10") = .Range("D3")
                    .Range("B10").Copy
                    .Range("B10:B" & .Range("B10").Offset(0, 1).End(xlDown).Row).PasteSpecial Paste:=xlPasteValues
                End If
            End With
        Next ws
    End With
    cDir = Dir
Loop
        
Set wbQuelle = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

Gruß Werner

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
07.09.2020 17:23:52 Gast52733
NotSolved
Blau Makro wählt nicht das nächste Sheet
 07.09.2020 18:39:00 Werner
Solved
08.09.2020 08:02:15 Gast96552
NotSolved