Makro hängt in einer Schleife

Hallo,
mein Makro hängt kurzzeitig in einer Schleife fest bevor das Makro beendet wird und ist zeitraubend (Ca. 5 sek.). Würde mir bitte jemamd helfen --> hier der Code:
Option Compare Text
Dim bln As Boolean


Private Sub Worksheet_SelectionChange _
(ByVal Target As Excel.Range)
Dim rng As Range
Set rng = Range("B2")
If Target.Address = rng.Address Then bln = True
If bln = True And Target.Address <> rng.Address Then
Call übertragen_aus_Daten
bln = False
End If
End Sub

---------------------------------------------------------
Sub übertragen_aus_Daten()
Dim A, B, C, D, E, F, G, H, I, J, K
Dim zähler
Sheets("Fill In").Select
Range("a1").Select
marke1: For zähler = 1 To 50000
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
End
Else

If ActiveCell.Value = "A" Then
Exit For
Else
End If
End If
Next
ActiveCell.Offset(0, 1).Select
A = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
B = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
C = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
D = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
E = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
F = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
G = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
H = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
I = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
J = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
K = ActiveCell.Value

Sheets("Data").Activate
Sheets("Data").Visible = True
ActiveCell.Activate
'ActiveCell.Offset(1, 0).Select
ActiveCell.Range("b1").Select
marke2: For zähler = 1 To 50000
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
Exit For
Else
End If
Next
ActiveCell.Value = A
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = B
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = C
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = D
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = E
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = F
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = G
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = H
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = I
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = J
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = K
ActiveCell.Offset(0, -10).Select
Sheets("Fill In").Select
Range("b2").Select
Sheets("Data").Visible = False
End Sub
Tausend Dank vorab und viele Grüsse
Tobias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange _ (ByVal Target As Excel.Range) Dim rng As Range Set rng = Range("B2") If Target.Address = rng.Address Then bln = True If bln = True And Target.Address <> rng.Address Then <b>Application.EnableEvents = False</b> Call übertragen_aus_Daten <b>Application.EnableEvents = True</b> bln = False End If End Sub

Private Sub Worksheet_SelectionChange _ (ByVal Target As Excel.Range) Dim rng As Range Set rng = Range("B2") If Target.Address = rng.Address Then bln = True If bln = True And Target.Address <> rng.Address Then Application.EnableEvents = False Call übertragen_aus_Daten Application.EnableEvents = True bln = False End If End Sub

Sub übertragen_aus_Daten() Dim A(10) As String Dim zähler Dim Sp Sheets("Fill In").Select Cells(1, 1).Select Selection.End(xlDown).Select ' Ans Ende der Zeilen Springen - in Spalte A dürfen keine leere Zellen sein For zähler = 1 To ActiveCell.Row Sheets("Fill In").Select For Sp = 1 To 10 A(Sp - 1) = Cells(zähler, Sp) Next Sp Sheets("Data").Select ' Kann sein das das ändern mußt For Sp = 1 To 10 Cells(zähler, Sp) = A(Sp - 1) Next Sp Next zähler ' Warum koppierst die daten nicht mit einem Makro komplett auf 1 mal End Sub

Sub übertragen_aus_Daten() Dim iZähler As Integer, RngF As Range Set RngF = Sheets("Fill In").Columns(1).Find(what:="A", after:=Range("A1")) Sheets("Data").Cells(65536, 1).End(xlUp).Offset(1, 0) = "A" For iZähler = 1 To 11 RngF.Offset(iZähler, 0).Copy Sheets("Data").Cells(65536, 1).End(xlUp).Offset(1, 0) Next iZähler End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread