25.06.2016, 14:13
Hallo mal wieder,
Ich hab mir ein Makro geschrieben, das mir auf einer Tabelle einen Filter setzt, die entspr. Daten in ein neues Datenblatt übernimmt und zu guter Letzt die neue Tabelle noch kurz durchformatiert.
Und gerade beim letzten Punkt habe ich einen Fehler. Und zwar in dem Absatz, wo die Spaltenbreite festgelegt wird. Die Spalte C ist nur dann richtig, wenn ich die Spalte D nicht formatiere. Ansonsten ist sie nicht genauso breit wie Spalte D.
Wer kann mir helfen?
Ich hab mir ein Makro geschrieben, das mir auf einer Tabelle einen Filter setzt, die entspr. Daten in ein neues Datenblatt übernimmt und zu guter Letzt die neue Tabelle noch kurz durchformatiert.
Und gerade beim letzten Punkt habe ich einen Fehler. Und zwar in dem Absatz, wo die Spaltenbreite festgelegt wird. Die Spalte C ist nur dann richtig, wenn ich die Spalte D nicht formatiere. Ansonsten ist sie nicht genauso breit wie Spalte D.
Wer kann mir helfen?
Code:
Sub Makro1()
Dim i As Long
Dim Tabelle1 As Worksheet
i = 0
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Sheets("MFormula").Range("A7:M500").Clear
'Daten mit Autofilter filtern
Range("F6").Select
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:="MF"
'gefilterte Daten kopieren
With ActiveSheet.AutoFilter.Range.Offset(-3)
.Cells(7, 4).Resize(.Rows.Count).Offset(, -3). _
Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
End With
'gefilterte Daten einfügen
Range("A7").Select
With Worksheets("MFormula")
.Paste Destination:=.Cells(.Rows.Count, 1).End(xlUp).Offset(1) 'Leerzeilen
End With
'Autofilter zurücksetzen
With Worksheets("Cosmos")
If .FilterMode Then
.ShowAllData
Selection.AutoFilter
End If
End With
Call Format
Application.CutCopyMode = False
Range("A7").Select
End Sub
Public Sub Format()
Dim i As Long
'Spaltenbreite kopierte Daten
Sheets("MFormula").Select
Columns("A:A").Select
Selection.ColumnWidth = 5
Columns("B:C").Select
Selection.ColumnWidth = 10
Columns("D:D").Select
Selection.ColumnWidth = 25
'Überschriftenzeile
Worksheets("Cosmos").Range("A6:D6").Copy Destination:=Worksheets("MFormula").Range("A6:D6")
Sheets("MFormula").Select
Rows("6:6").Select
With Selection.Interior
.ColorIndex = 49
.PatternColorIndex = xlAutomatic
End With
Rows("5:5").Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 49
End With
'Zeilen zweifarbig
For i = 7 To ActiveSheet.UsedRange.Rows.Count
If i Mod 2 = 1 Then
Rows(i).Interior.ColorIndex = 2
Else
Rows(i).Interior.ColorIndex = 24
End If
Next i
End Sub