Esta es la macro
Option Explicit
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
MkDir ("\\Hp-pcservidor\servidor solman\Produccion\OT\" & Cells(8, 19).Value)
'
Continuar = MsgBox("guardar pdf?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Range("A1:T49").Select
ChDir ("\\Hp-pcservidor\servidor solman\Produccion\OT\" & Cells(8, 19).Value)
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Cells(8, 19).Value, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'
Continuar = MsgBox("Guardar datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Datos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Datos")
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(1).Range("S8")
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(1).Range("E11")
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(1).Range("O11")
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(1).Range("O13")
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets(1).Range("E13")
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(1).Range("F29")
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(1).Range("F17")
.Cells(NewRow, 17).Value = ThisWorkbook.Sheets(1).Range("D40")
.Cells(NewRow, 13).Value = ThisWorkbook.Sheets(1).Range("E12")
.Cells(NewRow, 14).Value = ThisWorkbook.Sheets(1).Range("O94")
.Cells(NewRow, 16).Value = ThisWorkbook.Sheets(1).Range("F48")
End With
'
MsgBox "Datos Guardados", vbInformation, strTitulo
Limpiar = MsgBox("Borrar datos?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
With ActiveWorkbook.Sheets(1)
Range("D17,E11,E12,E13,O13,F29,F17,C17,D40,F47,F48").ClearContents
End With
Else
End If
'
End Sub
Es una compilación y modificación de algunas que encontré