Zeilen einfügen und Inhalt von bestimmten Spalten übernehmen

[hello123]

Hallo Zusammen,

ich möchte in meiner Excel-Tabelle mit Hilfe eines Buttons unterhalb der Zelle, die gerade aktiv ist, eine neue Zeile einfügen. Die Formeln sollen übernommen werden, aber auch der Inhalt der Spalten B und C (inkl.Formatierung) soll kopiert werden. Mit dem Makro, das ich gefunden wird eine neue Zeile eingefügt und die Formeln übernommen, nicht aber der Inhalt von den Spalten B und C.

Das Makro lautet:
Sub Zeileeinfügen()
' Aktuelle Zeile kopieren, unterhalb Zeile einfügen und Inhalte in Zellen ohne Formel löschen
'
    Dim Zelle As Range
    ActiveCell.EntireRow.Copy
    Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown
    For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End(xlToLeft))
      If Not Zelle.HasFormula Then
        Zelle.ClearContents
      End If
    Next Zelle
    Cells(ActiveCell.Row + 1, 1).Select
End Sub


Das Makro läuft allerdings etwa eine halbe Minute (oder sogar länger) ... ist das normal?

Kann mir jemand diesbezüglich weiterhelfen?

Vielen Dank im Voraus!

[hello123]

Keiner ne Idee? 

[maninweb]

Hallo,

grundsätzlich dauert das Schreiben von einzelnen Zellen in moderneren Excel-Versionen deutlich länger als in älteren Versionen.
Du könntest probieren, mal die Berechnung und Bildschirmaktualisierung während der Vorgänge auszuschalten.

Code: Visual Basic

1. Sub Zeileeinfügen()
2.  
3.   Dim Zelle As Range
4.    
5.   ActiveCell.EntireRow.Copy
6.   Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown
7.  
8.   Application.Calculation = xlCalculationManual
9.   Application.ScreenUpdating = False
10.  
11.   For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End(xlToLeft))
12.  
13.     If Not Zelle.HasFormula Then
14.      
15.       Zelle.ClearContents
16.      
17.     End If
18.  
19.   Next Zelle
20.  
21.   Application.ScreenUpdating = True
22.   Application.Calculation = xlCalculationAutomatic
23.  
24.   Cells(ActiveCell.Row + 1, 1).Select
25.  
26. End Sub

Gruß

[hello123]

Hallo,

vielen Dank! Es geht jetzt auf jeden Fall vieeel schneller! Besteht auch die Möglichkeit zusätzlich den Inhalt der Spalten B und C mittels Makro in die neu hinzugefügte Zeile übernehmen zu lassen?

Gruß

[hello123]

Hallo,

grundsätzlich dauert das Schreiben von einzelnen Zellen in moderneren Excel-Versionen deutlich länger als in älteren Versionen.
Du könntest probieren, mal die Berechnung und Bildschirmaktualisierung während der Vorgänge auszuschalten.

Code: Visual Basic

1. Sub Zeileeinfügen()
2.  
3.   Dim Zelle As Range
4.    
5.   ActiveCell.EntireRow.Copy
6.   Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown
7.  
8.   Application.Calculation = xlCalculationManual
9.   Application.ScreenUpdating = False
10.  
11.   For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End(xlToLeft))
12.  
13.     If Not Zelle.HasFormula Then
14.      
15.       Zelle.ClearContents
16.      
17.     End If
18.  
19.   Next Zelle
20.  
21.   Application.ScreenUpdating = True
22.   Application.Calculation = xlCalculationAutomatic
23.  
24.   Cells(ActiveCell.Row + 1, 1).Select
25.  
26. End Sub

Gruß

Hallo maninweb,

wie muss ich den Code ergänzen, damit der Inhalt der Spalten B und C der darüber liegenden Zeile in die neu eingefügte Zeile (inkl. Formatierung) kopiert wird?

Vielen Dank im Voraus für deine Unterstützung!

VG

[maninweb]

Hallo,

auf die schnelle ohne zu testen, versuche es mal damit...

Code: Visual Basic

1. Sub Zeileeinfügen()
2.  
3.   Dim Zelle As Range
4.    
5.   ActiveCell.EntireRow.Copy
6.   Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown
7.  
8.   Application.Calculation = xlCalculationManual
9.   Application.ScreenUpdating = False
10.  
11.   For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End(xlToLeft))
12.  
13.     If Not Zelle.HasFormula Then
14.      
15.       Zelle.ClearContents
16.      
17.       Select Case Zelle.Offset(-1, 0).Column
18.      
19.         Case 2 To 3
20.          
21.           Zelle.Value = Zelle.Offset(-1, 0).Value
22.          
23.         Case Else
24.        
25.       End Select
26.      
27.     End If
28.    
29.   Next Zelle
30.  
31.   Application.ScreenUpdating = True
32.   Application.Calculation = xlCalculationAutomatic
33.  
34.   Cells(ActiveCell.Row + 1, 1).Select
35.  
36. End Sub
37.  

Gruß

[hello123]

Hallo,

auf die schnelle ohne zu testen, versuche es mal damit...

Code: Visual Basic

1. Sub Zeileeinfügen()
2.  
3.   Dim Zelle As Range
4.    
5.   ActiveCell.EntireRow.Copy
6.   Cells(ActiveCell.Row + 1, 1).Insert Shift:=xlDown
7.  
8.   Application.Calculation = xlCalculationManual
9.   Application.ScreenUpdating = False
10.  
11.   For Each Zelle In Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 255).End(xlToLeft))
12.  
13.     If Not Zelle.HasFormula Then
14.      
15.       Zelle.ClearContents
16.      
17.       Select Case Zelle.Offset(-1, 0).Column
18.      
19.         Case 2 To 3
20.          
21.           Zelle.Value = Zelle.Offset(-1, 0).Value
22.          
23.         Case Else
24.        
25.       End Select
26.      
27.     End If
28.    
29.   Next Zelle
30.  
31.   Application.ScreenUpdating = True
32.   Application.Calculation = xlCalculationAutomatic
33.  
34.   Cells(ActiveCell.Row + 1, 1).Select
35.  
36. End Sub
37.  

Gruß

Funktioniert - herzlichen Dank!

VG

[maninweb]

Hallo,

bitte schön :-)

Tipp: vermeide bitte das Zitieren des vorherigen Beitrags, wenn Du antwortest. Denn Du antwortest ja auf den
vorhergehenden Beitrag, d.h. Zitieren stört dann schon den Lesefluss.

Gruß