Makro optimieren

Forumthread: Makro optimieren

Makro optimieren

edie

Hallo zusammen,
habe bereits das Makro aufgezeichnet und angepasst, nun hätte ichs
gerne etwas optimiert, wenns 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

AW: Makro optimieren

Gerd
Etwas optimiert

Backowe
AW: Etwas optimiert

edie

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

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)

Forumthread: Makro optimieren

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

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread