title image


Smiley Re: Zunächst mal hier posten
Ok sorry, bei allen moeglichen verschiedenen Makros taucht immer dieser fehler auf in der gleich lautenden Zeile (siehe weiter unten ">>>>>"), vorher kommt ne Fehler-Meldung "Type Mismatch":



Sub create_FS_Sheets(FS_Name As String)



Dim i_max, col_max, row_max As Integer



row_max = ActiveSheet.UsedRange.Rows.Count

col_max = ActiveSheet.UsedRange.Columns.Count



Sheets("FS 3").Select

Cells.Select

Selection.AutoFilter 'Autofilter einbauen

Selection.AutoFilter Field:=37, Criteria1:=FS_Name 'Autofilter definieren

Range(Cells(1, 1), Cells(row_max, col_max)).Select

Selection.Copy



Sheets.Add 'Neue Tabelle einfuegen

ActiveSheet.Name = FS_Name

ActiveWindow.Zoom = 85

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _

xlNone, SkipBlanks:=False, Transpose:=False



Sheets("FS 3").Select

i_max = ActiveSheet.UsedRange.Rows.Count

col_max = ActiveSheet.UsedRange.Columns.Count

Application.CutCopyMode = False 'Markierung aufheben



End Sub



Sub insert_blue_row(FS_Name As String)

Dim i_max2 As Integer

Sheets(FS_Name).Select

Set xlWS = ActiveSheet

xlWS.Activate



ref_z = 2

stopp = 0

i = 2



Do While stopp = 0



>>>>>> If Cells(i, 4).Value Cells(i - 1, 4).Value Then

Rows(i).Select

Selection.Insert Shift:=xlDown



Cells(i, 2).Select

ActiveCell.FormulaR1C1 = "week"

Cells(i, 3).Select

ActiveCell.FormulaR1C1 = "=R[-1]C[1]"



dif_z = i - ref_z 'erste Zeile der ausgewaehlten Woche

ref_z = i + 1 'erste Zeile der folgenden Woche



'Summe einfuegen (No. total)

Cells(i, 9).Value = "=sum(I" & i - dif_z & ":I" & i - 1 & ")"



'Summe einfuegen (No <=5)

Cells(i, 10).Value = "=sum(J" & i - dif_z & ":J" & i - 1 & ")"



'Prozent einfuegen

Cells(i, 11).Select

ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"



'Summe einfuegen (No <=5)

Cells(i, 61).Value = "=sum(BI" & i - dif_z & ":BI" & i - 1 & ")"



Rows(i).Select

Selection.Font.Bold = True

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range(Cells(i, 9), Cells(i, 10)).Select

Selection.Font.Bold = False



Cells(i, 11).Select

Selection.NumberFormat = "0.00%"



'blaue Zeile

col2_max = ActiveSheet.UsedRange.Columns.Count

Range(Cells(i, 1), Cells(i, col2_max)).Select

With Selection.Interior

.ColorIndex = 24

.PatternColorIndex = xlAutomatic

End With



'damit keine Endlosschleife Bedingung ist ja if (i).value > (i-1).value

i = i + 2



Else

If Cells(i, 4).Value = "" Then

If Cells(i + 1, 4).Value = "" Then

stopp = 1

Else

End If

Else

End If

i = i + 1

End If

Loop



Range("BF:BF").Select

Selection.NumberFormat = "m/d/yyyy h:mm"

Rows("2:2").Select

Selection.Delete Shift:=xlUp



End Sub

Sub Formatierung_Sheets(FS_Name As String)

Dim i_max As Integer



Sheets(FS_Name).Select

i_max = ActiveSheet.UsedRange.Rows.Count



'erste Zeile formatieren

Rows("1:1").Select

Selection.Font.Bold = True

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With



'fuer erstellte Spalten

Range("H2:J2").Select

Selection.NumberFormat = "General"

With Selection.Interior

.ColorIndex = 15 'grau hinterlegen

.Pattern = xlSolid

End With



'alle Zeilen anpassen

Range(Rows(2), Rows(i_max)).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With



Rows(2).Select

Selection.Copy

Range(Rows(2), Rows(i_max)).Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False



'spezielle Formatierung fuer Spalten L bis M (Abstract, Descr., Result)

Columns("L:M").Select

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With



'Zellenbreite formatieren

Columns("B:D").Select

Selection.ColumnWidth = 12

Columns("E:G").Select

Selection.ColumnWidth = 14

Columns("H:K").Select

Selection.ColumnWidth = 10

Columns("L:N").Select

Selection.ColumnWidth = 36

Columns("B").EntireColumn.AutoFit

Columns("H").EntireColumn.AutoFit



End Sub





Vielen Dank schonmal fuer Eure Geduld mit mir Newbie!



Florian

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: