Macro
Uploaded by
chandrasekarMacro
Uploaded by
chandrasekarSub try()
Dim i, j, k As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim a As Variant
Dim r As Range
Dim Save_Name As String
Dim Save_Location As String
Dim Master As Workbook
Set Master = ActiveWorkbook
Save_Location = InputBox("Specify the Save location for the SIS sheets:" & vbCrLf &
"(Right click the folder where the files have to be saved and choose copy as path,
paste the location here)")
Save_Location = Application.Substitute(Save_Location, Chr(34), "")
If Save_Location <> "" Then
i = 3
Sheet1.Activate
Range("b2").Select
'Set r = Range(Selection, Selection.End(xlToRight)).Select
j = Application.WorksheetFunction.CountA(Range(Selection,
Selection.End(xlToRight)))
Do While Sheet1.Cells(i, "B").Value <> ""
Save_Name = Application.Substitute(Sheet1.Cells(i, 110).Value, Chr(34), "")
For k = 2 To j + 1
Sheet3.Range(Sheet1.Cells(2, k).Value).Value = Sheet1.Cells(i, k).Value
Next
Sheets("MASTER").Select
Sheets("MASTER").Copy
Cells.Copy
Cells.PasteSpecial (xlPasteValues)
ActiveSheet.Shapes.Range(Array("Button 1")).Delete
ActiveWorkbook.SaveAs Filename:=(Save_Location & "\" & Save_Name & ".xlsx")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Save_Location & "\" &
Save_Name
ActiveWorkbook.Close
i = i + 1
Master.Activate
Loop
MsgBox ("DONE")
End If
End Sub