Anzahl Schleifendurchläufe per Zellenwert

Computer: Software & Programmierung Visual Basic
#1

Hallo ihr Spezis,
anhand des folgenden Makros übertrage ich eine Zeile in die erste freie Zeile meiner Datensammlung:

Sub Transfer()
    Application.ScreenUpdating = False 
    Sheets(„Definitions“).Range(„N3:Y3“).Copy
    Sheets(„Data Pool“).Select
    Range(„b“ & Range(„d65536“).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    Sheets(„Definitions“).Range(„N3:Y3“).ClearContents
    ThisWorkbook.Close Savechanges:=True

Nun möchte ich die Quellezellen mehr als 1 mal in die Datensammlung übertragen.
Ich habe aber leider keine Ahnung von Loops.
Am liebsten wäre mir wenn ich einfach in zB.: Zelle G3 eine 5 eintrage und das Transfer-Makro dann 5 mal durchläuft.

Und wenn ich schon dabei bin: Warum funktioniert es nicht, wenn ich

    Sheets(„Data Pool“).Select
    Range(„b“ & Range(„d65536“).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues

in einer Zeile zusammenfasse

Sheets(„Data Pool“).Range(„b“ & Range(„d65536“).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues

Danke schonmal im voraus!

#2

Hallo Marv,

Option Explicit

Sub Transfer1()
Dim Anz As Integer
Anz = Sheets("Definitions").Range("G3").Value
Application.ScreenUpdating = False
Sheets("Definitions").Range("N3:Y3").Copy
With Sheets("Data Pool")
 .Range("B" & .Range("D65536").End(xlUp).Row + 1).Resize(Anz, 12) \_
 .PasteSpecial Paste:=xlPasteValues
End With
Sheets("Definitions").Range("N3:Y3").ClearContents
Application.ScreenUpdating = True
ThisWorkbook.Close Savechanges:=True
End Sub

'oder

Sub Transfer2()
Dim N As Integer, Anz As Integer
Anz = Sheets("Definitions").Range("G3").Value
Application.ScreenUpdating = False
Sheets("Definitions").Range("N3:Y3").Copy
With Sheets("Data Pool")
 For N = 1 To Anz
 .Range("B" & .Range("D65536").End(xlUp).Row + 1) \_
 .PasteSpecial Paste:=xlPasteValues
 Next N
End With
Sheets("Definitions").Range("N3:Y3").ClearContents
Application.ScreenUpdating = True
ThisWorkbook.Close Savechanges:=True
End Sub

Gruß
Reinhard

#3

Super!!!
Vielen Dank es läuft.
Aber jetzt direkt die nächste Baustelle zu diesem Makro:
Wie bekomme ich da noch rein, dass die Zielzeile in einer anderen Datei liegt?

With Sheets(„Data Pool“) soll also nach möglichkeit irgendwie mit meinem folgenden Code aus einem anderen Projekt erweitert werden:

TOTAL = Tabelle2.[B8].Value

Range(„N3:Y3“).Copy
Workbooks.Open (ThisWorkbook.Path & „“ & TOTAL)
Sheets(„Total“).Select
Range(„b“ & Range(„b65536“).End(xlUp).Row + 1).Select
ActiveSheet.Paste
Windows(TOTAL).Close Savechanges:=True

Grüße,
Marv

#4

Aber jetzt direkt die nächste Baustelle zu diesem Makro:
Wie bekomme ich da noch rein, dass die Zielzeile in einer
anderen Datei liegt?

Hallo Marv,

Option Explicit

Sub Transfer3()
Dim Anz As Integer
With ThisWorkbook
 Anz = .Sheets("Definitions").Range("G3").Value
 Application.ScreenUpdating = False
 .Sheets("Definitions").Range("N3:Y3").Copy
 Workbooks.Open ThisWorkbook.Path & "\" & Worksheets(Tabelle2).[B8].Value
 With ActiveWorkbook.Sheets("Total")
 .Range("B" & .Range("D65536").End(xlUp).Row + 1).Resize(Anz, 12) \_
 .PasteSpecial Paste:=xlPasteValues
 End With
 .Sheets("Definitions").Range("N3:Y3").ClearContents
 Application.ScreenUpdating = True
 .Close Savechanges:=True
End With
End Sub

Gruß
Reinhard

#5

Läuft besten Dank nochmal!!!