Wie kann ich ein Makro in eine Schleife bekommen

Computer: Software & Programmierung Visual Basic
#1

Hallo,

ich habe nachfolgendes Makro aufgezeichnet für 2 Zeilen. Nun möchte ich, dass es sich für alle anderen Zeilen (die Datei hat ca. 2000) ebenfalls ausgeführt wird. Also einmal Datei Test öffnen, jede 5. Zeile aus Datei 1 in jede 6. Zeile (ohne Formeln) kopieren und die 1. Datei wieder schließen. Kann ich das irgendwie in einer Schleife machen?

Danke im Vorraus

Sheets(„Tabelle1“).Select
ChDir „C:\Rieck\Computer1\Testdatei“
Workbooks.Open Filename:= _
„C:\Rieck\Computer1\Testdatei\Test.xls“
Range(„H9:smiley:C9“).Select
Selection.Copy
Windows(„Test_1.xls“).Activate
Range(„G7“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(„Test.xls“).Activate
Range(„H14:smiley:A14“).Select
Application.CutCopyMode = False
Selection.Copy
Windows(„Test_1.xls“).Activate
Range(„G13“).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(„B3“).Select
Windows(„Test.xls“).Activate
ActiveWindow.Close

… mehr auf http://www.wer-weiss-was.de/app/query/send?queryid=1…

#2

Hallo,

ich habe nachfolgendes Makro aufgezeichnet für 2 Zeilen. Nun
möchte ich, dass es sich für alle anderen Zeilen (die Datei
hat ca. 2000) ebenfalls ausgeführt wird. Also einmal Datei
Test öffnen, jede 5. Zeile aus Datei 1 in jede 6. Zeile (ohne
Formeln) kopieren und die 1. Datei wieder schließen. Kann ich
das irgendwie in einer Schleife machen?

Hallo Anna,

ist ungetestet, probiere mal den Code.

Gruß
Reinhard

Option Explicit

Sub tt()
Dim wks1 As Worksheet, wks2 As Worksheet, Zei1 As Long, Zei2 As Long
Set wks1 = Workbooks("Test\_1.xls").Worksheets("Tabelle1")
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\Rieck\Computer1\Testdatei\Test.xls"
Set wks2 = Workbooks("Test.xls").Worksheets("Tabelle1")
Zei2 = 7
With wks1
 For Zei1 = 9 To wks2.Cells(Rows.Count, 8).End(xlUp).Row Step 5
 wks2.Range("H" & Zei1 & ":smiley:C" & Zei1).Copy
 .Range("G" & Zei2).PasteSpecial Paste:=xlPasteValues
 .Range("G" & Zei2).PasteSpecial Paste:=xlPasteFormats
 .Range("G" & Zei2).PasteSpecial Paste:=xlPasteComments
 Zei2 = Zei2 + 6
 Next Zei1
 .Range("B3").Select
 wks2.Parent.Close savechanges:=False
End With
Application.ScreenUpdating = True
End Sub
#3

OT Noch Interesse an deiner Anfrage :frowning: m.T.
Hallo,

ich bin selbst dran schuld. Ich habe vergessen bevor ich mir nen Kopf
machte einfach mal erstmal eine Nachfrage zu stellen.
Wenn darauf nicht reagiert wird, okay, Sache erledigt.
Wenn ja kann ich immer noch codieren.

Gruß
Reinhard