gunanidhi30
12-01-2013, 10:15 AM
Hello to Everyone !
I got the solution from this forum to split data into multiple sheet and then creating pdf.
The macro is working but the header is not populated properly in all splitted sheet.
See in attached sheet where text for column C (medra-pt) was not populated in other two sheets i.e. astrazeneca and johnson.
Sub CreateSheetsFromUniqueValzInColSaveAsPDF()
Dim cll As Range
Dim UqLst As String
Dim UqArr
Dim i As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
On Error Resume Next
For Each cll In Sheets("Data1").Columns(1).SpecialCells(2).Offset(1)
If InStr(UqLst, cll.Value) = 0 Then UqLst = UqLst & "|" & cll.Value
Next
UqArr = split(Mid(UqLst, 2), "|")
For i = LBound(UqArr) To UBound(UqArr)
Sheets(UqArr(i)).Delete
Sheets.Add(after:=Sheets(Sheets.Count)).Name = UqArr(i)
With Sheets("Data1")
.Range("A1").AutoFilter 1, UqArr(i)
.AutoFilter.Range.Copy Sheets(UqArr(i)).Range("A1")
End With
With Sheets(UqArr(i))
Application.PrintCommunication = False
With .PageSetup
.PrintArea = "$A:$N"
.PrintTitleRows = "$1:$1"
.LeftHeader = ""
.CenterHeader = Sheets("Data1").PageSetup.CenterHeader
.RightHeader = Sheets("Data1").PageSetup.RightHeader
.LeftFooter = Sheets("Data1").PageSetup.LeftFooter
.CenterFooter = ""
.RightFooter = ""
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
Application.PrintCommunication = True
.Columns.AutoFit
.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UqArr(i) & ".pdf"
End With
Next
With Sheets("Data1")
.Activate
.ShowAllData
End With
End Sub
I got the solution from this forum to split data into multiple sheet and then creating pdf.
The macro is working but the header is not populated properly in all splitted sheet.
See in attached sheet where text for column C (medra-pt) was not populated in other two sheets i.e. astrazeneca and johnson.
Sub CreateSheetsFromUniqueValzInColSaveAsPDF()
Dim cll As Range
Dim UqLst As String
Dim UqArr
Dim i As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
On Error Resume Next
For Each cll In Sheets("Data1").Columns(1).SpecialCells(2).Offset(1)
If InStr(UqLst, cll.Value) = 0 Then UqLst = UqLst & "|" & cll.Value
Next
UqArr = split(Mid(UqLst, 2), "|")
For i = LBound(UqArr) To UBound(UqArr)
Sheets(UqArr(i)).Delete
Sheets.Add(after:=Sheets(Sheets.Count)).Name = UqArr(i)
With Sheets("Data1")
.Range("A1").AutoFilter 1, UqArr(i)
.AutoFilter.Range.Copy Sheets(UqArr(i)).Range("A1")
End With
With Sheets(UqArr(i))
Application.PrintCommunication = False
With .PageSetup
.PrintArea = "$A:$N"
.PrintTitleRows = "$1:$1"
.LeftHeader = ""
.CenterHeader = Sheets("Data1").PageSetup.CenterHeader
.RightHeader = Sheets("Data1").PageSetup.RightHeader
.LeftFooter = Sheets("Data1").PageSetup.LeftFooter
.CenterFooter = ""
.RightFooter = ""
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
Application.PrintCommunication = True
.Columns.AutoFit
.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UqArr(i) & ".pdf"
End With
Next
With Sheets("Data1")
.Activate
.ShowAllData
End With
End Sub