Makro erstellen
09.06.2015 20:23:53
Tobias
ich bin mit der Programmierung von Makros noch sehr unerfahren, muss dies aber für eine Arbeit nun hinbekommen.
Ich möchte in meiner Datei die Daten aus einer Registerkarte in eine andere kopieren. Ist dies erfolgt sollen in der ersten Registerkarte wieder alle eingegebenen Daten gelöscht werden. Habe ich nun neue Daten eingegeben, so sollen diese ebenfalls in die zweite Registerkarte kopiert werden, jedoch rechts daneben.
Ich habe bei jetzt ein Makro aufzeichnen können, dass all dies macht, nur werden dabei die Daten kopiert und danach Spalten links eingefügt. Dort werden dann die nächsten Werte gespeichert usw.
Ich hoffe mir kann da jemand helfen.
Hier mein Code, keine Ahnung ob der hilfreich ist:
Sub Werte_zur_Scoreübersicht()
' Werte_zur_Scoreübersicht Makro
Range("B1:B10").Select
Selection.Copy
Sheets("Scoreübersicht").Select
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D5").Select
Application.CutCopyMode = False
Selection.Style = "Currency"
Range("D10").Select
Selection.Style = "Currency"
Range("D1:D4").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("Portfoliobewertung").Select
Range("D9").Select
Selection.Copy
Sheets("Scoreübersicht").Select
Range("D15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Portfoliobewertung").Select
Range("K15:K112").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Scoreübersicht").Select
Range("D18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D18:D115,D15").Select
Range("D15").Activate
Application.CutCopyMode = False
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"
Selection.NumberFormat = "0.00%"
Sheets("Portfoliobewertung").Select
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 15
Range("H15:H112").Select
Selection.Copy
Sheets("Scoreübersicht").Select
Range("E18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 20
Range("D1:E115").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("F13:G13").Select
Selection.Copy
Range("D13").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Portfoliobewertung").Select
Range("K109:K112,K102:K106,K97:K99").Select
Range("K97").Activate
ActiveWindow.SmallScroll Down:=-9
Range("K109:K112,K102:K106,K97:K99,K90:K92").Select
Range("K90").Activate
ActiveWindow.SmallScroll Down:=-3
Range("K109:K112,K102:K106,K97:K99,K90:K92,K82:K87").Select
Range("K82").Activate
ActiveWindow.SmallScroll Down:=-12
Range("K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79").Select
Range("K76").Activate
ActiveWindow.SmallScroll Down:=-12
Range("K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79,K67:K69,K59:K64"). _
Select
Range("K59").Activate
ActiveWindow.SmallScroll Down:=-12
Range( _
"K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79,K67:K69,K59:K64,K52:K56"). _
Select
Range("K52").Activate
ActiveWindow.SmallScroll Down:=-9
Range( _
"K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79,K67:K69,K59:K64,K52:K56,K42:K47" _
).Select
Range("K42").Activate
ActiveWindow.SmallScroll Down:=-9
Range( _
"K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79,K67:K69,K59:K64,K52:K56,K42:K47, _
K38:K39,K33:K35" _
).Select
Range("K33").Activate
ActiveWindow.SmallScroll Down:=-12
Range( _
"K109:K112,K102:K106,K97:K99,K90:K92,K82:K87,K76:K79,K67:K69,K59:K64,K52:K56,K42:K47, _
K38:K39,K33:K35,K27:K30,K20:K24,B1" _
).Select
Range("B1").Activate
Selection.ClearContents
End Sub