Code của Maika8008 có bỏ qua trường hợp inputbox chỉ nhập 1 số, không có dấu ",". Dựa vào code của Maika8008 và yêu cầu lưu file, bạn tham khảo code sau:
Sub PrintMultiPage()
Dim sInput$, inputArr() As String, sNote$, Filename$
Dim aPrint() As Long, i&, j&, k&, lastRow&, startNum&, endNum&
Dim FSO As Object
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists("D:\TAM") = True Then
Else
FSO.CreateFolder ("D:\TAM")
End If
Set FSO = Nothing
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
"Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
inputArr = Split(sInput, ",")
For i = LBound(inputArr) To UBound(inputArr)
If InStr(inputArr(i), "-") > 0 Then
startNum = CLng(Left(inputArr(i), InStr(inputArr(i), "-") - 1))
endNum = CLng(Right(inputArr(i), Len(inputArr(i)) - InStr(inputArr(i), "-")))
For j = startNum To endNum
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = j
Next j
Else
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = CLng(inputArr(i))
End If
Next i
For i = LBound(aPrint) To UBound(aPrint)
Filename = Application.WorksheetFunction.VLookup(aPrint(i), Sheets("Data").Range("A1:M" & lastRow), 13, False)
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\TAM\" & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
