AW: Dateien in Ordner öffnen,Makro ausführen
07.09.2015 13:05:35
braun
Da ist jetzt was schief gelaufen, hier nochmal der ganze Code
Private Sub Makro1()
'Tabelle aufbereiten
'Spalten löschen
Range("A:A,C:C,E:E,BF:DC").Delete
'neue Spalten einfügen
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H2").Select
ActiveCell.FormulaR1C1 = "AAAA"
Range("H1").Select
ActiveCell.FormulaR1C1 = "BBB"
Range("G2").Select
ActiveCell.FormulaR1C1 = "CCC"
Range("G1").Select
ActiveCell.FormulaR1C1 = "DDD"
'Formel:Datumsformat ändern
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR((DATE(LEFT(RC[2],4),MID(RC[2],5,2),RIGHT(RC[2],2)))),""ohne Datum"",DATE(LEFT( _
RC[2],4),MID(RC[2],5,2),RIGHT(RC[2],2)))"
With ActiveSheet
'letzte Zeile auffinden:
lngLetzte = .UsedRange.Rows.Count + .UsedRange.Row - 1
'Formel aus G3 runterziehen
.Range(.Cells(3, 7), Cells(lngLetzte, 7)).Formula = .Cells(3, 7).Formula
End With
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR((DATE(LEFT(RC[-2],4),MID(RC[-2],5,2),RIGHT(RC[-2],2)))),""ohne Datum"", _
DATE(LEFT(RC[-2],4),MID(RC[-2],5,2),RIGHT(RC[-2],2)))"
With ActiveSheet
'letzte Zeile auffinden:
lngLetzte = .UsedRange.Rows.Count + .UsedRange.Row - 1
'Formel aus H3 runterziehen
.Range(.Cells(3, 8), Cells(lngLetzte, 8)).Formula = .Cells(3, 8).Formula
End With
Columns("G:H").Select
Selection.NumberFormat = "m/d/yyyy"
End Sub
Private Sub Makro2()
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "BBBBBBBBB"
Range("H2").Select
ActiveCell.FormulaR1C1 = "BBBBBBBBB"
End Sub
Private Sub Makro3()
Range("H3").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(IF(RC[1]="""",99,NETWORKDAYS(RC[-1],RC[1]))-1),"""", _
IF(RC[1]="""",99,NETWORKDAYS(RC[-1],RC[1]))-1)"
Columns("H:H").Select
Selection.NumberFormat = "0"
With ActiveSheet
'letzte Zeile auffinden:
lngLetzte = .UsedRange.Rows.Count + .UsedRange.Row - 1
'Formel aus H3 runterziehen
.Range(.Cells(3, 8), Cells(lngLetzte, 8)).Formula = .Cells(3, 8).Formula
End With
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Filter einbauen
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'Spaltengröße anpassen
Columns("A:P").EntireColumn.AutoFit
End Sub
Private Sub Makro4()
Sheets(1).Select
Sheets.Add After:=Sheets(1)
Sheets(2).Name = "ABC"
Sheets(1).Select
Rows("1:2").Select
Selection.Copy
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Sheets(1).Select
startzeile = 2
'Spalte die geprüft wird
Spalte = 5
grenzwert = 5
startzeile2 = 2
Spalte2 = 10
Spalte3 = 1
grenzwert2 = "TEST"
grenzwert3 = "TEST2"
Sheets(1).Select
Letzte_Zeile = Range(Cells(65536, Spalte), Cells(65536, Spalte)).End(xlUp).Row
For i = startzeile To Letzte_Zeile
On Error Resume Next
If Sheets(1).Cells(i, Spalte) > grenzwert And Sheets(1).Cells(i, Spalte2) = grenzwert2 And _
Sheets(1).Cells(i, Spalte3) = grenzwert3 Then
'hier copieren der Zellinhalte
Sheets(1).Rows(i & ":" & i).Copy
Sheets(2).Select
Cells(startzeile2, 1).Select
ActiveSheet.Paste
startzeile2 = startzeile2 + 1
Else
End If
Next
'Filter einbauen
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
'Überschriften fixieren
Range("A2").Activate
ActiveWindow.FreezePanes = True
'Spaltengröße anpassen
Columns("A:W").EntireColumn.AutoFit
End Sub