Excel Makro, spalten automatisch löschen
26.08.2005 11:01:11
MS
ich habe folgendes Problem mit dem unten aufgeführten Makro.
Das Makro bearbeitet eine Ausgangstabelle mit 26 Spalten und 150 Zeilen.
Es sucht eine Spalte nach Namen ab und erstellt anschließend für jeden Namen ein eigenes Sheet. In jedem Sheet ist dann der jeweilige gefundene Name incl. der kompletten Zeile, die sich aus 26 Zellen zusammensetzt.
Ich benötige aber nur 6 bestimmte Zellen für meine Auswertung, wie kann ich das Makro so abändern, dass nicht die komplette Zeile (26 Spalten), sondern nur 6 vordefinierte Zellen (6 Spalten) in meine Sheets übernommen werden?
Bin über jede Hilfe dankbar.
______________________________________________________________________________
Option Explicit
Private Sub cmdVerkListeErstellen_Click()
Dim rngQ As Range
Set rngQ = Worksheets("Ausgangstabelle").Columns(17)
Worksheets("Ausgangstabelle").Activate
rngQ.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Verkäuferliste").Columns(1), Unique:=True
Worksheets("Verkäuferliste").Activate
End Sub
Private Sub cmdProVerkaeufer_Click()
'filtern
Dim wbk As Workbook
Dim wksCrit As Worksheet
Dim wksDat As Worksheet
Dim wksFilt As Worksheet
Dim xLastCell&
Dim rngDat As Range
Dim rngCrit As Range
Dim rngFilt As Range
Dim xAbRowFilter&
Dim lngZeile&
Dim lngBisSpalte&
Dim lngBisZeile&
Set wbk = ThisWorkbook
Application.ScreenUpdating = False
Set wksCrit = wbk.Worksheets("Verkäuferliste")
Set wksDat = wbk.Worksheets("Ausgangstabelle")
lngBisSpalte = wksDat.Cells(1, Columns.Count).End(xlToLeft).Column
lngBisZeile = wksDat.Cells(Rows.Count, 17).End(xlUp).Row
wksCrit.Cells(1, 5).Value = wksCrit.Cells(1, 1).Value
For lngZeile = 2 To wksCrit.Cells(Rows.Count, 1).End(xlUp).Row
wksCrit.Cells(2, 5).Value = wksCrit.Cells(lngZeile, 1).Value
Set wksFilt = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
wksFilt.Name = wksCrit.Cells(lngZeile, 1).Text
Set rngCrit = wksCrit.Range(wksCrit.Cells(1, 5), wksCrit.Cells(2, 5))
Set rngDat = wksDat.Range(wksDat.Cells(1, 1), wksDat.Cells(lngBisZeile, lngBisSpalte))
Set rngFilt = wksFilt.Range(wksFilt.Cells(2, 1), wksFilt.Cells(Rows.Count, lngBisSpalte))
wksCrit.Activate
rngDat.AdvancedFilter xlFilterCopy, rngCrit, rngFilt
wksFilt.Activate
Next
wksFilt.Activate
Application.ScreenUpdating = True
End Sub