Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1572to1576
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen kopieren

Zellen kopieren
15.08.2017 12:37:17
Zac
Hallo wertes Forum,
ich habe ein kleines Problem. Und zwar möchte ich mehrere Zellen einer Reihe (teilweise mit Formeln), (F8:AL8), in die darunter liegenden Zellen kopieren lassen, aber nur, wenn in der dazugehörigen Zelle ab D11 ein Wert steht. Das funktioniert auch soweit, allerdings relativ langsam. Kann man hier noch optimieren?
  • 
    Sub Kopieren()
    Dim Zeile As Integer
    With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    End With
    With ThisWorkbook.Worksheets("Tabelle1")
    For Zeile = 11 To 200
    If Range("D" & Zeile).Value  "" Then
    Range("F8:AL8").Copy
    Range("F" & Zeile).PasteSpecial Paste:=xlPasteAll
    End If
    Next Zeile
    End With
    With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .CutCopyMode = False
    End With
    Range("b11").Select
    End Sub
    

  • Danke für Rückmeldung

    5
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Zellen kopieren
    15.08.2017 13:00:40
    Werner
    Hallo,
    meinst du das?
    Public Sub Kopieren()
    Dim loLetzte As Long
    With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, 4).End(xlUp).Row
    If loLetzte > 10 Then
    Set raBereich = .Range(.Cells(11, 6), .Cells(loLetzte, 6))
    .Range("F8:H8").Copy raBereich
    Else
    MsgBox "Keine Daten in Spalte D ab Zeile 11 vorhanden."
    End If
    End With
    End Sub
    
    Gruß Werner
    AW: Zellen kopieren
    15.08.2017 13:12:17
    Zac
    Hi Werner,
    danke schon mal für die Antwort. Funktioniert theoretisch, hier wird aber nicht überprüft, ob in den Zellen ab D11 Folgende ein Wert enthalten ist. Nur wenn hier was steht, soll kopiert werden. Bsp.: D11 bis D15 hat einen Wert (kopieren), D16 bis D28 ist leer (hier soll nicht kopiert werden), dann D29 ist wieder was vorhanden usw.
    Anzeige
    AW: Zellen kopieren
    15.08.2017 14:22:12
    Werner
    Hallo,
    versuch mal das hier. Ob das aber schneller ist kann ich im Moment auch nicht sagen, der Code läuft ja auch in einer For - Next Schleife über die einzelnen Zeilen.
    Public Sub Kopieren()
    Dim raBereich As Range
    Dim raZelle As Range
    Dim loLetzte As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Worksheets("Tabelle1")
    loLetzte = .Cells(.Rows.Count, 4).End(xlUp).Row
    If loLetzte > 10 Then
    Set raBereich = .Range(.Cells(11, 6), .Cells(loLetzte, 6))
    For Each raZelle In raBereich
    If raZelle.Offset(0, -2)  "" Then
    .Range("F8:AL8").Copy raBereich
    End If
    Next raZelle
    Else
    MsgBox "Keine Daten in Spalte D ab Zeile 11 vorhanden."
    End If
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub
    
    Gruß Werner
    Anzeige
    AW: Zellen kopieren
    15.08.2017 14:40:16
    Zac
    Danke, danke. Ist auch nicht wirklich schneller. Ich habe allerdings gerade die Ursache für die langsame Geschwindigkeit gefunden. In drei der zu kopierenden Zellen sind Formeln mit Verknüpfungen zu anderen Arbeitsmappen enthalten. Wenn ich diese testweise lösche, gehts deutlich schneller.
    Gerne u. Danke für die Rückmeldung. o.w.T.
    15.08.2017 14:43:23
    Werner

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige