Makro überträgt keine Zahlen

Sub SätzeAufAnderesTabellenblattÜbertragen() Const Blatt1 = "Tab2" Const Blatt2 = "Angebot" Dim i As Integer Dim iAnz As Integer Application.ScreenUpdating = False Sheets("Tab2").Activate Range("A2").Select iAnz = 0 i = 0 Do Until i = ActiveSheet.UsedRange.Rows.Count If ActiveCell.Value <> "" Then Range(Cells(rng.Row, 1), Cells(rng.Row, 3)).Copy Sheets("Angebot").Range("A21").Select Selection.Insert Shift:=xlDown iAnz = iAnz + 1 Else ActiveCell.Offset(1, 0).Select End If i = i + 1 Loop Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Es wurden " & iAnz & " Sätze übertragen" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Matthias,

... und ich weiss auch, dass ich manchmal chaotisch programmiere:

Aber das was dort steht ist definitiv nicht von mir !!


Sub SätzeAufAnderesTabellenblattÜbertragen()
Ich arbeite nur in Extremen Ausnahmefällen mit Constanten
Const Blatt1 = "Tab2"
Const Blatt2 = "Angebot"
Dim i As Integer
Dim iAnz As Integer
Application.ScreenUpdating = False
Sheets("Tab2").Activate
Range("A2").Select
iAnz = 0
i = 0
Do Until i = ActiveSheet.UsedRange.Rows.Count
If ActiveCell.Value <> "" Then
Da ich immer "Option Explicit" verwende
kann sowas "rng" = nicht definierte und bearbeitete Variable
mir nicht passieren
Welche Zeile soll denn da referenziert werden ?
Er kann ja gar nichts finden weil "rng" nicht existiert
Range(Cells(rng.Row, 1), Cells(rng.Row, 3)).Copy
Sheets("Angebot").Range("A21").Select
Selection.Insert Shift:=xlDown
iAnz = iAnz + 1
Else
ActiveCell.Offset(1, 0).Select
End If
i = i + 1
Loop
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Es wurden " & iAnz & " Sätze übertragen"
End Sub

Ich hätte es so gemacht :-))

Option Explicit


Sub SätzeAufAnderesTabellenblattÜbertragen()
Dim Blatt1 As Worksheet
Dim Blatt2 As Worksheet
Dim i As Integer
Dim iAnz As Integer
Set Blatt1 = Worksheets("Tab2")
Set Blatt2 = Worksheets("Angebot")
Application.ScreenUpdating = False
iAnz = 0
For i = 1 To Blatt1.UsedRange.Count
If Blatt1.Cells(i, 1) <> "" Then
Blatt2.Rows(21).Insert shift:=xlDown
Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=Blatt2.Range("A21")
iAnz = iAnz + 1
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Es wurden " & iAnz & " Sätze übertragen"
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro überträgt keine Zahlen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread