Hallo an alle,
folgende Bitte: Ich habe ein excel-file mit folgendem VBA-Code
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Range("DataStart").Parent.Name <> Sh.Name Then
Dim rngCrit As Range
On Error Resume Next
Set rngCrit = Sh.Range("DataCrit")
On Error GoTo 0
If Not rngCrit Is Nothing Then
Filter Sh
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Range("DataStart").Parent.Name <> Sh.Name Then
Dim rngAct As Range
Set rngAct = ActiveCell
On Error GoTo ErrorHandler
Set Target = Intersect(Target, Sh.Range(Sh.Range("DataCrit").Row & ":" & Sh.Range("DataGoal").Row - 1).EntireRow)
If Not Target Is Nothing Then
Filter Sh
Application.GoTo rngAct
End If
End If
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Filter(Sh As Object)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim lngRows As Long
Dim rngGoalData As Range
With Sh
lngRows = .Range(.Range("DataCrit").Row & ":" & .Range("DataGoal").Row - 1). _
Find(What:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rngGoalData = .Range("DataGoal").CurrentRegion
If rngGoalData(1, 1).Row < .Range("DataGoal").Row Then
rngGoalData.Offset(.Range("DataGoal").Row - 1, 0).Clear
Else
.Range("DataGoal").CurrentRegion.Clear
End If
Range("DataStart").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range(.Range("DataCrit").Row & ":" & lngRows), _
CopyToRange:=.Range("DataGoal"), _
Unique:=False
End With
ErrorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Public Sub ReSharpen()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
damit werden die im ersten mappenblatt eingetragenen daten mittels kürzel in der entsprechenden spalte zeilenweise auf die weiteren mappenblätter verteilt.
nun habe ich das problem, dass ich auf den nachfolgenden blättern nichts abseits der für mich relevanten 6 spalten machen kann, da sonst der code nicht mehr funktioniert.
bin auf dem gebiet VBA ziemlich ahnungslos. könnte mir bitte jemand den code so ändern, dass nur die spalten A-G (also 6) zeilenweise kopiert werden? wäre sehr dankbar!!!
lg
|