Rename Tab based on cell value, but only use first 30 characters

All,

I have a workbook that has 100 worksheets in it, i want the worksheets to be renamed based on the value in cell b1 for each worksheet. However if there are invalid characters or the name is too long it gives an error. How I just reference the first 30 valid characters.

Thanks again.

Option Explicit

Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ws.Name = ws.Range("b1").Value

Next ws
End Sub