kopier sheet ud fra listbox og navngiv via. tekstbox

Jeg har et bid kode til at liste en række sheets op og vil nu genbruge denne til at lave en funktion der kan kopier det valgte ark og give den et navn skrevet i en tekstbox.
Tekstbox’en hedder Txt.Text og skal hvis man ikke skriver noget, åbne MsgBox "Navn skal udfyldes" og ikke køre før udfyldt.

Koden jeg bruger til optællingen se sådan ud:

Dim sSheet
For Each sSheet In Sheets
  If sSheet.Type = 3 Then
    ListBox1.AddItem sSheet.Name
  ElseIf WorksheetFunction.CountA(sSheet.Range("N1")) > 0 Then
      ListBox1.AddItem sSheet.Name
  End If
Next sSheet