Datenübernahme aus einer Datei
16.11.2004 08:37:46
jtajo
Ich möchte die Übernahme jetzt auf ca 20 Datensätze erweitern. Wer kann mir weiterhelfen und mir mitteilen wo die Parameter für ca 20 Datensätzen hierin verborgen sind?
Sub Makro1()
' Makro1 Makro
' Makro am 23.08.04 von XXXX aufgezeichnet
ActiveWindow.ActivateNext
Application.Run "WindowChanged"
ActiveWorkbook.Unprotect password:="Markus"
Sheets("Datenzusammenstellung NL").Visible = True
Sheets("Datenzusammenstellung NL").Select
'Ab Hier neu
Range("Bh3:Bw10").Select
Range("BT4").Activate
Selection.Replace What:="$J$", Replacement:="$E$", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
Range("A20").Select
ActiveCell.FormulaR1C1 = "=R[-17]C"
Range("A20").Select
Selection.Copy
Range("A21:A27").Select
ActiveSheet.Paste
Range("A20:A27").Select
Selection.Copy
Range("B20:H20").Select
ActiveSheet.Paste
Range("I20").Select
ActiveCell.FormulaR1C1 = "=IF(LEN(R[-17]C)=12,""""&R[-17]C,0)"
Range("I20").Select
Selection.Copy
Range("I21:I27").Select
ActiveSheet.Paste
Range("I20:I27").Select
Selection.NumberFormat = "@"
Range("J20").Select
ActiveCell.FormulaR1C1 = "=R[-17]C"
Range("J20").Select
Selection.Copy
Range("J21:J27").Select
ActiveSheet.Paste
Range("J20:J27").Select
Selection.Copy
Range("K20:AV20").Select
ActiveSheet.Paste
Range("BH20").Select
ActiveCell.FormulaR1C1 = "=R[-17]C"
Range("Bh20").Select
Selection.Copy
Range("BH21:BH27").Select
ActiveSheet.Paste
Range("BH20:BH27").Select
Selection.Copy
Range("BI20:BW20").Select
ActiveSheet.Paste
Range("F20:F27").Select
Application.CutCopyMode = False
Selection.NumberFormat = "General"
Range("Af20:Au27").Select
Selection.NumberFormat = "m/d/yy"
Range("k20:k27").Select
Selection.NumberFormat = "m/d/yy"
Range("A20:Bw27").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("A20:Bw27").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("A20:Bw27").Select
Selection.Copy
Windows("TVZ-Termincontrolling.V5-BD_KW.xls").Activate
Sheets("Zwischenablage").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Columns("Bi:Bx").Select
Selection.Cut
Columns("Aw:Aw").Select
Selection.Insert Shift:=xlToRight
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(SUM(RC[10]:RC[61])>0,1,0)"
Range("A1").Select
Selection.Copy
Range("A2:A8").Select
ActiveSheet.Paste
Range("A1:A8").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ActivateNext
Application.Run "WindowChanged"
ActiveWorkbook.Close savechanges:=False
Windows("TVZ-Termincontrolling.V5-BD_KW").Activate
Sheets("Zwischenablage").Select
Range("A1").Select
For z = 1 To 8
i = i + 1
Cells(i, 1).Activate
If Cells(ActiveCell.Row, 1) = 0 Then
ActiveCell.EntireRow.Delete
i = i - 1
End If
Next
Range("A1").Select
Application.Run "Makro3"
End Sub
Sub Makro3()
' Makro3 Makro
' Makro am 24.08.04 von XXX aufgezeichnet
Range("AD1:AD8").Select
Selection.NumberFormat = "#,##0.00 $"
Range("v1:v8").Select
Selection.NumberFormat = "0.00%"
Range("B1:BM8").Select
Selection.Copy
Sheets("Termincontrolling").Select
Range("b400").Select
ActiveSheet.Paste
Range("b2:Bm408").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("d2"), Order1:=xlAscending, Key2:=Range("i2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Range("A1").Select
Range("Bm2:Bm200").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlJustify
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A1").Select
End Sub