Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1124to1128
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1124to1128
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro optimieren

Makro optimieren
edie
Hallo zusammen,
habe bereits das Makro aufgezeichnet und angepasst, nun hätte ich’s
gerne etwas optimiert, wenn’s geht.
Der Bereich ("A3:A8") wird in Abhängigkeit des Target-Wertes kopiert
z. B. beim Wert 2 in ("A5:A15") beim Wert 3 in ("A5:A15") und ("A17:A22")
u.s.w…
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$K$10" And Not IsEmpty(Target) = True Then
If Target.Value = 2 Then
Range("A3").Select
Range("A3:A8").Copy
ActiveCell.Offset(7, 0).PasteSpecial
ElseIf Target.Value = 3 Then
Range("A3").Select
Range("A3:A8").Copy
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ElseIf Target.Value = 4 Then
Range("A3").Select
Range("A3:A8").Copy
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ElseIf Target.Value = 5 Then
Range("A3").Select
Range("A3:A8").Copy
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ElseIf Target.Value = 6 Then
Range("A3").Select
Range("A3:A8").Copy
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
ActiveCell.Offset(7, 0).PasteSpecial
End If
End If
Application.CutCopyMode = False
End Sub
Vorab vielen Dank für die Hilfe.
Grüße

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro optimieren
02.01.2010 23:12:02
Gerd
Hallo Edie,
ungetestet:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lngOffset As Long
With Target
If .Address = "$K$10" Then
If .Value >= 2 And .Value
Gruß Gerd
Etwas optimiert
02.01.2010 23:12:05
Backowe
Hi edie,
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim i As Integer, n As Integer
If Target.Address = "$K$10" And IsNumeric(Target) Then
  If Target > 1 And Target < 7 Then
    n = 3
    For i = 1 To Target.Value
      Range("A3:A8").Copy
      Range("A" & n & ":A" & n + 5).PasteSpecial xlPasteValues
      n = n + 7
    Next
  End If
End If
Application.CutCopyMode = False
End Sub
Gruß Jürgen
AW: Etwas optimiert
edie

Hallo Gerd L,
Hallo Backowe,
bin immer wieder überrascht, klappt wunderbar, vielen herzlichen Dank.
Danke und einen schönen Abend noch.
Grüße
Anzeige
AW: Etwas optimiert
02.01.2010 23:27:54
edie
Hallo Gerd L,
Hallo Backowe,
bin immer wieder überrascht, klappt wunderbar, vielen herzlichen Dank.
Danke und einen schönen Abend noch.
Grüße

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige