AW: Zellen mit allen Funktionen kopieren
18.06.2013 14:21:07
Martin
hallo franz!
vielen dank fuer deine erste hilfe! also das kopieren funktioniert nun schon. und auch mein problem, dass die filterfunktion (nicht sortierfunktion) nicht mitkopiert wird ist geloest, aber nur wenn ich das sub einmal durchlaufen lasse, und wenn das sheet3 noch sauber ist!
jetzt muesste das nur immer so sein, und auch die formatierung (spaltenbreite) muesste noch uebernommen werden. dann wuerde es fuer meine zwecke passen.
das suchkriterium 3805 wir spaeter von einem andern sub kommen, und daher variabel sein.
darf ich dir unten meinen code zur ansicht einfuegen?
danke im voraus,
gruss,
martin
Sub ZeilenKopieren3()
Dim lngStartZeile As Long, lngEndeZeile As Long
Dim wksQ As Worksheet, wksZ As Worksheet
Set wksQ = Worksheets("SPOC-Contingency Task")
Set wksZ = Worksheets("Sheet3")
wksZ.Rows(1).Insert
wksQ.Rows(1).Copy Destination:=wksZ.Rows(1)
Sheets("SPOC-Contingency Task").Select
ActiveSheet.Range("$a$1:$h$65536").AutoFilter Field:=1, Criteria1:="=3805", _
Operator:=xlAnd
For lngStartZeile = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
If Rows(lngStartZeile).Hidden = False Then
Cells(lngStartZeile, 2).Select
Exit For
End If
Next
lngEndeZeile = Cells(Rows.Count, (1)).End(xlUp).Row
lngEndeZeile = Cells(Rows.Count, "A").End(xlUp).Row
Range(Rows(lngStartZeile), Rows(lngEndeZeile)).Select
Selection.Copy
Sheets("Sheet3").Select
Rows("2:2").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=0
Sheets("SPOC-Contingency Task").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Range("A4").Select
Sheets("Sheet3").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Range("A1").Select
End Sub
/pre>