AW: 2 Makros hintereinander laufen lassen
19.09.2005 20:55:10
Peter
Hallo Aton,
bekomme es nicht hin.
Habe beide Makros mal hochgeladen
Sub Peter()
Worksheets("Tabelle1").Unprotect Password:="test"
'Application.Run
Sub StrichRahmenSetzen()
Range("A:A,B:B,E:E").Select ' ausblenden
Range("E1").Activate
Selection.EntireColumn.Hidden = True
Range("Datenbank2").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("SuchenTabelle"), CopyToRange:= _
Range("ZielTabelle"), Unique:=False
Range("F6:L50").Select
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = xlAutomatic
End With
'Range("M17").Select
ActiveWindow.SmallScroll Down:=12
Range("A7:p40").Select
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = xlAutomatic
' Range("A1").Activate
' ActiveWindow.ScrollRow = 12
'ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
End With
'Range("A1").Select
Range("F5:X40").Select
Selection.ClearContents
Range("F6").Select
For Ze = 7 To 1000 ' Von der Zeile 10 bis(to) zur Zeile 1000 die Kreuze setzen
Sp = 1 ' Spalte auf 1 um festzustellen ob alle erfasst werden.
If Cells(Ze, 1) = "" Then End ' Abbruch, wenn Spalte 1 also A kein ( 6d ) zelle leer ist.
A = Cells(Ze, 5)
For Sp = 6 To 250 Step 2 ' 2 Spalten weiter
If Cells(5, Sp) = A Then
Exit For ' Schleife verlassen Nationalität gefunden
Else
If Cells(5, Sp) = "" Then ' Neue Nationalität eintragen
Cells(5, Sp) = A
Cells(5, Sp + 1) = A
Cells(6, Sp) = "M"
Cells(6, Sp + 1) = "W"
Exit For ' Schleife verlassen Neue Nationalität
End If
End If
Next Sp
If Cells(Ze, 2) = "w" Then Sp = Sp + 1 ' Kreuz auf Frau korriegieren
Cells(Ze, Sp) = "x" ' Kreuz setzen ohne selection
'Cells(Ze, Sp).Select ' Activiert diese Zelle sichtbar. wie anklicken mit der Maus
'ActiveCell = B ' schreibt string B in Activecell
' Mit der Taste F8 kanst du das Makro Zeile für Zeile laufen lassen.
Next Ze
End Sub
Sub StrichRahmenSetzen()
Range("c7").CurrentRegion.Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlNone
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlNone
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlNone
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlNone
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlNone
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlNone
.Weight = xlThin
End With
'Worksheets("Tabelle1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test"
End Sub
Mfg. Peter