Beiträge zum Thread: Daten Prüfbuch

Sub monatlichgeprüftMitOhneMängel()



    Dim wsQuelle As Worksheet

    Dim wsZiel As Worksheet

    Dim zielZeile As Long

    Dim EqNr As String

    Dim Pfad As String



    Set wsQuelle = Worksheets("Brandschutztüren monatlich ")

    EqNr = wsQuelle.Range("C3")

    Set wsZiel = Worksheets(EqNr)

    Pfad = "C:\Users\kzimmermann\Desktop\Test Prüfbuch\" 'mit \ am Ende

    

    

    With wsZiel

        ' nächste freie Zeile ab A17 finden

        zielZeile = .Cells(.Rows.Count, "A").End(xlUp).Row

            If zielZeile < 17 Then zielZeile = 17 Else zielZeile = zielZeile + 1

        

        ' Werte übertragen

        .Cells(zielZeile, "A").Value = wsQuelle.Range("B34").Value

        .Cells(zielZeile, "B").Value = wsQuelle.Range("A26").Value

        .Cells(13, "C").Value = wsQuelle.Range("D5").Value

            

        wsQuelle.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

            Pfad & EqNr & ".pdf", Quality:=xlQualityStandard, _

            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _

            False

            

    End With

End Sub