title image


Smiley Re: Ich habe die Antwort leider nicht kapiert
Hallo Antiproff,

ich habe mal gelernt es gibt keine dummen Fragen nur dumme Antworten :)

Ich meinte 2 Zeilen aus dem Makro löschen.

Das "If a > 1 Then" bewirkte das nur Zeilen übernommen werden wenn größer 1,

also wird alles kleiner 2 nicht übernommen.

Dann muss natürlich auch End If gelöscht werden.

Solltest du keine Überschriften brauchen musst du die Zeilen

wksZiel.Cells(1, 1).Value ..... löschen





Sub Zeilen_kopieren3()

Dim wksQuelle As Worksheet

Dim wksZiel As Worksheet

Dim Verz As String

Dim lzq%, lz%, a%, i%, b%

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Set wksQuelle = ActiveSheet

Worksheets.Add Before:=ActiveWorkbook.Worksheets(1)

Set wksZiel = Worksheets(1)

lzq = wksQuelle.Cells(Rows.Count, 1).End(xlUp).Row

wksZiel.Cells(1, 1).Value = "Kommission"

wksZiel.Cells(1, 2).Value = "Mengenangabe"

wksZiel.Cells(1, 3).Value = "Beschreibung"

lz = 2

For i = 2 To lzq Step 1

a = wksQuelle.Cells(i, 2)

For b = a To 1 Step -1

wksZiel.Rows(lz).Value = wksQuelle.Rows(i).Value

lz = lz + 1

Next b

Next i

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub



Gruß

Reiner

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: