Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
892to896
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schleife zum kopeiren von Daten

Schleife zum kopeiren von Daten
09.08.2007 11:14:00
Daten
Hallo,
ich möchte aus einem Arbeitsblatt Daten auslesen und habe dazu ein Makro geschrieben bzw aufgenommen und entsprechend verifiziert.
Aus Tabelle2 sollen Daten ausgelesen werden und in Tabelle1 übernommen werden! Dies soll allerdings unter 2 Bedingungen geschehen:
1. Wenn in Tabelle1 Die Zelle J11 einen bestimmten Wer hat, soll in Tabelle2 eine spezielle Zelle angewählt werden!
"J11" aus Tabelle1 geht in 10er Schritten von 10 bis 1000
wenn der Wert 10 beträgt, soll in Tabelle2 folgendes ablaufen:
Sheets("Tabelle1").Select
If Range("J11") = 10 Then
Sheets("Tabelle2").Select
Range("BP23:CK23").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A16").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Tabelle2").Select
Range("BP10:CK10").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A22").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Tabelle2").Select
Range("BP36:CK36").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A28").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
' ...... usw... insgesamt sollen 10 passagen kopiert werden
End If
End Sub
Wenn der Wert 20 beträgt, soll in Tabelle2 das selbe ablaufen nur genau 43 Zeilen weiter unten, bei dem Wert 30 86 Zeilen weiter unten usw...
Die zweite Bedingung ist ein Wochentag in Tabelle1. Der Wochentag steht in Tabelle1 in Zelle ("A9")
In meinem Beispiel ist der Tag Montag. Wenn A9 = Dienstag soll in Tabelle2 das selbe ablaufen nur eine Zeile weiter unten, bei MIttwoch 2 Zeilen weiter unten usw...
DAs ist doch bestimmt mit einer Schleife machbar, oder? Nur leider fehlt mir absolut das Können und die Erfahrung, dies umzusetzen! Vielleicht kann mir einer weiterhelfen! Über jeden Ansatz bin ich dankbar!
Danke im voraus, Toni

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

Betreff
Datum
Anwender
Anzeige
AW: Schleife zum kopeiren von Daten
09.08.2007 11:22:00
Daten
Hallo Toni,
ich vermute mal mit eine Schleife kannst Du da nichts machen. Es gibt vielleicht beim Kopierbereich eine (ale 13 Zeilen) aber bei Ziel ist mir keine aufgefallen.
In VBA kann zu 99,9% auf select verzichtet werden. Mal ungetestet. Ich baue die Datei nicht nach.

Option Explicit
Sub Toni()
With Sheets("Tabelle2")
If Sheets("Tabelle2").Range("J11") = 10 Then
.Range("BP10:CK10").Copy
Sheets("Tabelle1").Range("A22").PasteSpecial Paste:=xlPasteFormulas
.Range("BP23:CK23").Copy
Sheets("Tabelle1").Range("A16").PasteSpecial Paste:=xlPasteFormulas
.Range("BP36:CK36").Copy
Sheets("Tabelle1").Range("A28").PasteSpecial Paste:=xlPasteFormulas
End If
End With
End Sub



Anzeige
AW: Schleife zum kopeiren von Daten
09.08.2007 11:36:28
Daten
hallo Haj,
deine Version ohne Select ist schonmal wesentlich kürzer als meine! Habe es eben probiert und es funktioniert!
Vielen Dank soweit, das vereinfacht es schon ein wenig!
Allerdings bleibt das Problem, dass dies auf 700 verschiedene fälle anzuwenden ist!
Was ich vielleicht im ersten post nicht erwähnt habe: In Tabelle1 verändert sich nichts! Dort werden die Daten immer an der selben Stelle eingefügt! Lediglich in Tabelle2 ändert sich je nach Bedingung die Stelle wo kopiert werden soll

AW: Schleife zum kopeiren von Daten
09.08.2007 11:41:00
Daten
Hallo Toni,
und diese Bedingung hast Du uns noch nicht mitgeteilt.
Gruß Hajo

Anzeige
AW: Schleife zum kopeiren von Daten
09.08.2007 11:55:22
Daten
sorry, ich dachte das hätte ich in meinem ersten post...
also:
Bedingung Nummer 1:
In Tabelle1 steht in einer bestimmten Zelle ("J11) eine Zahl zwischen 10 und 1000 die durch 10 teilbar ist also 10, 20, 30, 40 ... usw
Wenn diese Zahl 10 beträgt soll so kopiert werden wie es bereits funktioniert! Jedesmal wenn der Wert um 10 steigt, soll exakt 43 Zeilen weiter unten kopiert werden!
Bedingung Nummer 2:
In Tabelle1 steht in einer weiteren bestimmten Zelle ("A9) ein Wochentag!
Bei meinem Beispiel habe ich den Montag genommen. Wenn der Tag Dienstag ist soll in Tabelle 2 eine Zeile tiefer kopiert wrden
Als Beispiel:

Sub Toni()
With Sheets("Tabelle2")
If Sheets("Tabelle1").Range("J11") = 10 Then
.Range("BP10:CK10").Copy
Sheets("Tabelle1").Range("A22").PasteSpecial Paste:=xlPasteFormulas
End If
End Sub


Wenn nun


Sub Toni()
If Sheets("Tabelle1").Range("J11") = 30 Then
.Range("BP10:CK10").Copy         ' aber 86 Zeilen weiter unten
'dazu noch der Bezug auf den Tag also
If Sheets("Tabelle1").Range("A)") = Dienstag Then
.Range("BP10:CK10").Copy        ' aber 86 Zeilen weiter unten UND noch eine  _
Zeile weiter unten
End If
End Sub


Ich hoffe Du verstehst was ich meine...

Anzeige
AW: Schleife zum kopeiren von Daten
09.08.2007 12:04:56
Daten
Hallo Toni,
das ist mir zu hoch. Ich hätte Vermutet die Zeilen die kopiert werden sind 13 Zeilen auseinander und nicht 43 ( 10;2;36) Aber es könnte ja sein das ich nicht rechnen kann. Und wie man von Dienstag auf die Zeile A22; A16; A28 kommt ist mir auch zu hoch. Ich bin raus.
Gruß Hajo

AW: Schleife zum kopeiren von Daten
09.08.2007 12:17:00
Daten
Die Zeilen die kopiert werden sind unterschiedlich weit auseinander nur in meiner Bedingung soll eben jeweils 43 Zeilen nach unten gegangen werden.
Das kann man so als Basis nehmen und es eben je nach Bedingung verschieben

Sub Toni()
With Sheets("Tabelle2")
If Sheets("Tabelle1").Range("J11") = 10 Then
.Range("BP10:CK10").Copy
Sheets("Tabelle1").Range("A22").PasteSpecial Paste:=xlPasteFormulas
.Range("BP23:CK23").Copy
Sheets("Tabelle1").Range("A16").PasteSpecial Paste:=xlPasteFormulas
.Range("BP36:CK36").Copy
Sheets("Tabelle1").Range("A28").PasteSpecial Paste:=xlPasteFormulas
.Range("AT10:BO10").Copy
Sheets("Tabelle1").Range("A34").PasteSpecial Paste:=xlPasteFormulas
.Range("B36:W36").Copy
Sheets("Tabelle1").Range("A40").PasteSpecial Paste:=xlPasteFormulas
.Range("B23:W23").Copy
Sheets("Tabelle1").Range("A46").PasteSpecial Paste:=xlPasteFormulas
.Range("X23:AS23").Copy
Sheets("Tabelle1").Range("A63").PasteSpecial Paste:=xlPasteFormulas
.Range("X10:AS10").Copy
Sheets("Tabelle1").Range("A69").PasteSpecial Paste:=xlPasteFormulas
.Range("X36:AS36").Copy
Sheets("Tabelle1").Range("A75").PasteSpecial Paste:=xlPasteFormulas
.Range("B10:W10").Copy
Sheets("Tabelle1").Range("A81").PasteSpecial Paste:=xlPasteFormulas
.Range("AT23:BO23").Copy
Sheets("Tabelle1").Range("A87").PasteSpecial Paste:=xlPasteFormulas
.Range("AT36:BO36").Copy
Sheets("Tabelle1").Range("A93").PasteSpecial Paste:=xlPasteFormulas
End If
End With
End Sub


Dieses ganze Ding soll mit allem was sich auf Tabelle2 bezieht um je 43 Zeilen nach unten verschoben werden wenn sich Sheets("Tabelle1").Range("J11") um 10 erhöht
Die Paste Option die in Tabelle1 angewendet wird ist IMMER identisch egal wie der Wert in ("J11") ist
Vielleicht hat jemand anderes einen Tip

Anzeige
AW: Schleife zum kopeiren von Daten
13.08.2007 09:30:05
Daten
Hallo Toni,
wenn ich das richtig verstanden habe, folgt das Ganze einer gewissen Regel. Steht in J11 '10', dann beginnst Du in Zeile 10 mit dem kopieren, steht in J11 '20', dann beginnst Du in Zeile 10+43, steht in J11 '30', dann beginnst Du in Zeile 10+(2x43) mit dem Kopieren? Analog dazu werden sich auch die anderen kopierten Zeilen jeweils um diesen Wert erhoehen? I'm confused... :-)
Ich hab mal eine Loesung gemacht, so wie ich das verstanden hab. Ich hoffe Du kannst es noch brauchen. Da brauchst Du auch dann nicht mehr unterscheiden, was in J11 steht, Es sollte nur sichergestellt sein, dass der Wert durch 10 geteilt eine ganze Zahl ergibt.
Lass mich wissen, ob es so funktioniert, wie Du es Dir vorgestellt hast, ob es falsch war oder ob dabei etwas explodiert ist... ich habe vorher nicht getestet :-)
Gruss
Rainer

Sub Toni()
With Sheets("Tabelle2")
Dim startrow As Double
If Sheets("Tabelle1").Range("J11")  1000 Then
MsgBox "Zahl nicht zulaessig..."
Exit Sub
End If
startrow = 10 + (((Sheets("Tabelle1").Range("J11") / 10) - 1) * 43)
'If Sheets("Tabelle1").Range("J11") = 10 Then
.Range(.Cells(startrow, "BP"), .Cells(startrow, "CK")).Copy
'.Range("BP10:CK10").Copy
Sheets("Tabelle1").Range("A22").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 13, "BP"), .Cells(startrow + 13, "CK")).Copy
'.Range("BP23:CK23").Copy
Sheets("Tabelle1").Range("A16").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 26, "BP"), .Cells(startrow + 26, "CK")).Copy
'.Range("BP36:CK36").Copy
Sheets("Tabelle1").Range("A28").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow, "AT"), .Cells(startrow, "BO")).Copy
'.Range("AT10:BO10").Copy
Sheets("Tabelle1").Range("A34").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 26, "B"), .Cells(startrow + 26, "W")).Copy
'.Range("B36:W36").Copy
Sheets("Tabelle1").Range("A40").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 13, "B"), .Cells(startrow + 13, "W")).Copy
'.Range("B23:W23").Copy
Sheets("Tabelle1").Range("A46").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 13, "X"), .Cells(startrow + 13, "AS")).Copy
'.Range("X23:AS23").Copy
Sheets("Tabelle1").Range("A63").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow, "X"), .Cells(startrow, "AS")).Copy
'.Range("X10:AS10").Copy
Sheets("Tabelle1").Range("A69").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 26, "X"), .Cells(startrow + 26, "AS")).Copy
'.Range("X36:AS36").Copy
Sheets("Tabelle1").Range("A75").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow, "B"), .Cells(startrow, "W")).Copy
'.Range("B10:W10").Copy
Sheets("Tabelle1").Range("A81").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 13, "AT"), .Cells(startrow + 13, "BO")).Copy
'.Range("AT23:BO23").Copy
Sheets("Tabelle1").Range("A87").PasteSpecial Paste:=xlPasteFormulas
.Range(.Cells(startrow + 26, "AT"), .Cells(startrow + 26, "BO")).Copy
'.Range("AT36:BO36").Copy
Sheets("Tabelle1").Range("A93").PasteSpecial Paste:=xlPasteFormulas
'End If
End With
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige