hallo
ich will etwas mit Makro kopieren, bin da aber absolut neu und ..... naja laut meiner Letzten Testung in einer Beruflichen Reha habe ich Logische Ausfälle (ich nenne es mal so)
das zu Verstehen wird also schwierig
nur
ich will es trostdem hinbekommen
also wie kopiere ich etwas mit VBA?
der Ursprung sieht so aus
Arbeitsblatt test
alfa beta gama
1 2 3 usw
ich will nun das
das 1 unter alfa in das Arbeitblatt alfa in zelle b2 kopiert wird
danach
das 2 unter Beta in das Arbeitsblatt Beta in Zelle b2 Kopiert wird
und dann
das 3 unter gama in das Arbeitsblatt gama in zelle b2 kopiert wird
usw
ich hoffe ich konnte halbwegs ausdrücken was ich machen will
nur nun die Frage
wie bekomme ich Excel dazu das es das macht?
vielleicht gibt es ja auch copy array befehle
... hmm oder auch nicht :19:
Code:
Sub kopieren()
Dim i As Integer
Dim myWsh As Worksheet
With Sheets("test")
For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set myWsh = Worksheets(.Cells(1, i).Text)
If Err.Number = 0 Then
myWsh.Cells(2, 2) = .Cells(2, i)
End If
Next i
End With
End Sub
Das erfordert aber, dass die Blätter entsprechend den Überschriften vorhanden sind.
na gut ich mache es mal als klartext, und pfeife auf die Vereinfachungen
ich will das
1&1 Drillisch Aareal Bank Airbus alstria office REIT Aroundtown Property Holdings
28,88 € 22,46 € 124,82 € 14,09 € 7,656 €
und weitere
in die jeweiligen Tabelleblätter kopiert werden
also
28,88 in Arbeitsblatt 1&1 Drillisch
22.46 in Arbeitsblatt Aareal Bank
124.82 in Arbeitsblatt Airbus
usw
und Zielzelle ist jedesmal b20
und das per Makro das ich einmal am Tag ausführe
Und was sagt dein zweiter Beitrag jetzt anderes aus als dein erster? Dein Anliegen wurde verstanden und von mir als Makro umgesetzt. Was willst du denn mehr? Hast du den Code getestet?
MisterBurns
weil ich es nicht verstehe
hmm
gibt es nichts einfaches?
sowas wie
Kopiere x2 aus worksheet abc = zu a2 in worksheet xyz
was man dann natürlich 50 mal wiederholen muß
unsauber ich weiß aber für mich verständlicher
Hallo,
ohne Schleife geht es so in der Art:
Sub Kopieren()
Worksheets("Test").Range("A2").Copy Worksheets("alfa").Range("B2")
Worksheets("Test").Range("B2").Copy Worksheets("beta").Range("B2")
Worksheets("Test").Range("C2").Copy Worksheets("gama").Range("B2")
'usw.
End Sub
Gruß Uwe
Was ist denn mit dir los? Ich habe dir eine fixfertige Lösung erstellt, du musst sie nur noch einfügen und ausführen. Noch einfacher geht es doch wohl kaum, oder?
Hallöchen,
hier mal der Code von Berni mit Kommentaren. Die sind teilweise auch noch recht kryptisch an den Codezeilen orientiert, helfen aber eventuell beim Verständnis. Der Code geht in einer Schleife von Spalte zu Spalte, schaut, was dort in Zeile 1 steht und übernimmt dann den Inhalt von Zeile 2 auf das Blatt entsprechend dem Eintrag von Zeile 1. Gibt es das Blatt nicht, passiert nix und es wird einfach mit dem nächsten Eintrag weitergemacht. Wenn DU mal ein neues Blatt hast und einen Eintrag in Zeile 1 hinzufügst oder ein Blatt weglöschst, brauchst Du im Code nix zu ändern. Benennst Du das Blatt mal um und änderst den Eintrag in Zeile 1, brauchst Du im Code auch nix zu ändern.
Wenn Du mal ein Blatt bzw. eine Spalte auslassen willst, hast Du es mit der umständlichen Variante natürlich einfacher, da brauchst Du nur die Zeile im Code wegnehmen
Code:
Sub kopieren()
'Variablendeklarationen
Dim i As Integer
Dim myWsh As Worksheet
'Mit dem Tabellenblatt test
With Sheets("test")
'Schleife ueber alle Spalten bis zur letzten in Zeile 1 gefuelleten ab Spalte 1 (A)
For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
'Bei Fehler weiter mit naechster Codezeile
On Error Resume Next
'Tabellenblatt entsprechend EIntrag in Zeile 1 setzen
Set myWsh = Worksheets(.Cells(1, i).Text)
'Wenn kein Fehler (Blatt ist vorhanden), dann
If Err.Number = 0 Then
'Eintrag aus Zeile 2 Spalte i auf Zielblatt, B2 (Zelle 2,2) uebernehmen
myWsh.Cells(2, 2) = .Cells(2, i)
'Ende Wenn kein Fehler (Blatt ist vorhanden), dann
End If
'Ende Schleife ueber alle Spalten bis zur letzten in Zeile 1 gefuelleten ab Spalte 1 (A)
Next i
'Mit dem Tabellenblatt test
End With
End Sub
Code:
Sub M_snb()
For Each it In Sheets("test").Cells(1).CurrentRegion.Rows(2).Cells
If Evaluate("not(isref(" & it.Offset(-1) & "!A1))") Then Sheets.Add(, Sheets(Sheets.Count)).Name = it.Offset(-1)
Sheets(it.Offset(-1).Value).Cells(2, 2) = it
Next
End Sub
BTW. Es gibt ein 'array'copy Method:
Code:
Sub M_snb()
For Each it In Cells(1).CurrentRegion.Rows(2).Cells
If Evaluate("not(isref(" & it.Offset(-1) & "!A1))") Then Sheets.Add(, Sheets(Sheets.Count)).Name = it.Offset(-1)
Sheets(Array(it.Parent.Name, it.Offset(-1).Value)).FillAcrossSheets it
Next
End Sub
guten morgen ihr alle , wer sich auf regt ist selber schuld :D
so das dazu
ich haben das nun mit 50 mal
Worksheets("test").Range("b3").Copy Destination:=Worksheets("Aareal Bank").Range("b20")
Worksheets("test").Range("c3").Copy Destination:=Worksheets("Airbus").Range("b20")
Worksheets("test").Range("d3").Copy Destination:=Worksheets("alstria office REIT").Range("b20")
gelöst
aber nun das neuen Problem
die Daten die ich aus dem Netz bekommen sehen so aus "20 €"
wobei das Leerzeichen Zwichen Zahl und € Zeichen kein Leerzeichen ist.
ich habe es mir im Hexadezimal angeschaut, ein Leerzeichen ist eine 20 das was aus der Webseite kommt ist eine A0
sieht leer aus bewirkt aber das Excel das nicht als Zahl erkennt sonder als Text, und kann somit damit nicht weiter arbeiten.
nun suche ich denn Befehl um diese "Störung" zu löschen.
iregendwas mit Worksheets("test").Rows(3).........
vielleicht habt ihr ja eine Idee
aber warscheinlicher ist das ich durch intensives suchen wieder selbst drauf komme,
aber wie immer
danke ich euch für die Mühe
auch wenn ich es zum Teil nicht verstehe , es viel zu kompliziert ist.
nehmt es mir nicht zu sehr übel und trink ein Radler und denkt an mich
und kein Grund ärgerlich zu sein denkt euch einfach "soll er es nehmen oder eben nicht, dann ist es seine Schuld, selbst wenn er noch 30mal Protestiert"