.printout Problem

Sub besteinfuegen()
Dim varTextDatei
Dim strPfadAkt As String, rngEinfuegZelle As Range
Dim msg As Integer
strPfadAkt = VBA.CurDir 'Aktives Verzeichnis merken
VBA.ChDir "Macintosh HD:Users:Shared:" 'Verzeichnis mit Textdateien
varTextDatei = Application.GetOpenFilename(Title:="Bitte die soeben erstellte Datei auswählen" _
)
If varTextDatei  False Then
If InStr(1, LCase(varTextDatei), "best") > 0 Then
Set wksBestellung = Worksheets("Bestellungen")
'Einfügezelle ermitteln
With wksBestellung
If .Cells(.Rows.Count, 1).End(xlUp).Row >= 3 Then
Set rngEinfuegZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Set rngEinfuegZelle = .Range("A3")
End If
End With
wksBestellung.Activate
'Querrydaten holen
With wksBestellung.QueryTables.Add(Connection:="TEXT;" & varTextDatei, Destination:= _
rngEinfuegZelle)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 9, 9, 1, 9, 1, 9, 9, 1, 9)
.Refresh BackgroundQuery:=False
Activesheets.PrintOut
End With
Dim objQuerry As QueryTable
'Querries löschen
For Each objQuerry In wksBestellung.QueryTables
objQuerry.Delete
Next
Call spaltenbest
Else
msg = MsgBox(" " & vbNewLine & "                       Möchten Sie eine andere Datei  _
importieren?", vbYesNo, "  Die Datei ist ungültig und kann nicht importiert werden!")
If msg = vbYes Then
Call besteinfuegen
Else
Exit Sub
End If
End If
End If
VBA.ChDir strPfadAkt 'aktuelles Verzeichnis zurücksetzen
End Sub
Sub spaltenbest()
Columns("A:A").ColumnWidth = 6.33
Columns("B:B").ColumnWidth = 48.33
Columns("C:C").ColumnWidth = 10.17
Columns("D:D").ColumnWidth = 40.67
Columns("E:E").ColumnWidth = 5.83
Columns("F:F").ColumnWidth = 18.67
End Sub

Nun zu meinem Problem. Leider druckt er mir nur zwei Striche aus. Wenn ich das richtig sehe nämlich nur die Zelle, die gerade Blau umrandet, also activ ist.
Mein Wunschtraum wäre aber, das er mir NUR die Zellen ausdruckt die Text enthalten UND ich müsste vorher noch einen Drucker wählen können-...
Kann VBA das?
Eine leider immernoch Anfängerin hofft demütig auf Hilfe ;o)
Danke und LG :*