Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1548to1552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code Anpassung - Zeile hinzufuegen

Code Anpassung - Zeile hinzufuegen
22.03.2017 14:49:52
Gerhardt
Hallo zusammen,
ich habe einen kleinen Code, der die Spalte A1 sortiert und fuer jedes Sortierergebnis eine PDF Datei erstellt. Nun soll zusaetzlich noch die Zeile 2575 in jedes Blatt mitkopiert werden. Die Zeile enthaelt eine Summenformel, die immer die Summe fuer die SOrtiervorschlaege ausgibt. Kann jemand diese kleine Aenderung im Code vornehmen?
Code:
Option Explicit
Sub FilterAndPDF()
Dim ItemList As Variant
Dim i As Long
ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Name = "DataList" 'anpassen
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
FindUniqueItems ItemList, "DataList"
ActiveSheet.Range("DataList").AutoFilter
For i = 1 To UBound(ItemList)
ActiveSheet.Range("DataList").AutoFilter 1, ItemList(i)
Application.StatusBar = "PDF " & ItemList(i)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & Application.PathSeparator & ItemList(i) & ".pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
Application.StatusBar = False
ActiveSheet.ShowAllData
End Sub
Private Sub FindUniqueItems(UniqueItems As Variant, FilterRange As String)
Dim TempList() As String, UniqueCount As Integer, cl As Range, i As Integer
Range(FilterRange).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
UniqueCount = Range(FilterRange).SpecialCells(xlCellTypeVisible).Count
ReDim TempList(1 To UniqueCount - 1)
i = 0
For Each cl In Range(FilterRange).SpecialCells(xlCellTypeVisible)
i = i + 1
If i > 1 Then TempList(i - 1) = cl.Formula
Next cl
Set cl = Nothing
UniqueItems = TempList
End Sub
Vielen Dank fuer die Unterstuetzung!!!
VG Gerhardt

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Anpassung - Zeile hinzufuegen
23.03.2017 15:13:03
Gerhardt
Ich Weiss, dass es sehr viel Code ist, der durchgelesen warden muss. Jedoch muss wirklich nur eine Kleinigkeit ergaenzt warden. Ich hoffe, es findet sich jemand. Meiner Meinung nach liegt das Problem im oberen Codeteil:

Sub FilterAndPDF()
Dim ItemList As Variant
Dim i As Long
ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Name = "DataList" 'anpassen
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
FindUniqueItems ItemList, "DataList"
ActiveSheet.Range("DataList").AutoFilter
For i = 1 To UBound(ItemList)
ActiveSheet.Range("DataList").AutoFilter 1, ItemList(i)
Application.StatusBar = "PDF " & ItemList(i)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & Application.PathSeparator & ItemList(i) & ".pdf", Quality:= _
xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
Application.StatusBar = False
ActiveSheet.ShowAllData
End Sub
Bitte helft mir! :D
VG Gerhardt
Anzeige
AW: Code Anpassung - Zeile hinzufuegen
24.03.2017 13:34:46
Gerhardt
oT
AW: Code Anpassung - Zeile hinzufuegen
24.03.2017 13:35:10
Gerhardt
owT

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige