Hay Leute,
es steht das nächste Problem an :-)
Die Anforderungen werden immer größer, weil es durch eure Hilfe so gut funktioinert :-)
Bevor die Kopierfunktion startet, müssen 2 Bedingungen durchgeführt werden:
Wenn in Spalte I eine "2" steht, dann soll in Spalte Q das Zeichen "./." geschrieben werden.
Wenn in Spalte I eine "3" steht, dann soll in Spalte K und Q das Zeichen "./." geschrieben werden.
Ich hoffe auf eure Hilfe!!!
Folgendes Makro habe ich bis jetzt:
Sub Archivierungsliste_erstellen()
Dim strFilename As String
Dim wkb As Workbook
Dim lngLZ As Long
Dim rngL As Range
' Pfad definieren
pfad = "O:\ABT\RW2\SCG\Aufgaben\Makro_Vollstreckung\scg\"
'Workbook definieren
Set wkb = Workbooks.Open(Filename:="O:\ABT\RW2\SCG\Aufgaben\Makro_Vollstreckung\scg\Abschreibung_Titel_aktuell.xlsx", Local:=True)
'Spalten W bis BB ausblenden
Columns("W:BB").EntireColumn.Hidden = True
'Kopieren der oberen Zeile in untere Zeile
On Error Resume Next
lngLZ = Cells(Rows.Count, 1).End(xlUp).Row - 1
Application.ScreenUpdating = False
For Each rngL In Range("A4:D" & lngLZ).SpecialCells(xlCellTypeBlanks)
rngL.Value = rngL.Offset(-1).Value
Next rngL
For Each rngL In Range("I4:K" & lngLZ).SpecialCells(xlCellTypeBlanks)
rngL.Value = rngL.Offset(-1).Value
Next rngL
For Each rngL In Range("M4:U" & lngLZ).SpecialCells(xlCellTypeBlanks)
rngL.Value = rngL.Offset(-1).Value
Next rngL
Application.ScreenUpdating = True
' Excel als PDF abspeichern
strFilename = Application.GetSaveAsFilename( _
InitialFileName:=pfad & "Abschreibung_Titel_BHI_2014_MM.pdf", _
FileFilter:="PDF (*.pdf), *.pdf", _
Title:="als PDF speichern")
If strFilename <> "Falsch" Then
wkb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename
End If
'Spalten W bis BB einblenden
Columns("W:BB").EntireColumn.Hidden = False
'Workbook schließen
Workbooks("Abschreibung_Titel_aktuell.xlsx").Close savechanges:=False
End Sub
|