[winoni71]

Originariamente inviato da Raffaele53

Sul HD del PC deve esistere una Directory = Excel macro, all'interno un'altra Directory = Titles.

Si, esatto, avevo modificato la directory perchè conteneva il mio nome, ma effettivamente quella reale è composta in quel modo.

Originariamente inviato da Raffaele53

Adesso dopo la riga >>>For lColLoop = 1 To 7<<< vai accapo e scrivi>>> If Cells(lRowLoop, 5) <> "" Then
Subito prima di >>>Next lRowLoop<<< vai accapo e scrivi>>> End if

Avvia ed avrai in C:\Excel macro\Titles\ dei files (ex s10e01#.???.title) solo se nella cella in colonna F c'è scritto un qualcosa.

Ho modificato il codice come indicato, ma quando lo avvio mi da il seguente errore (Errore di compilazione: Next senza For) evidenziando in giallo "Sub RunCode()" ed in blu "Next".

Sub Titles()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
    For Each xSh In Worksheets
        xSh.Select
        Call RunCode
    Next
    Application.ScreenUpdating = True
End Sub
Sub RunCode()
    'your code here
Const forReading = 1, forAppending = 3, fsoForWriting = 2
Dim fs, objTextStream, sText As String
Dim lLastRow As Long, lRowLoop As Long, lLastCol As Long, lColLoop As Long

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lRowLoop = 1 To lLastRow

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objTextStream = fs.opentextfile("C:\Users\*******\Documents\Tv shows\Titles\Excel macro\Titles\" & Cells(lRowLoop, 1) & ".title", fsoForWriting, True)

    sText = ""

    For lColLoop = 1 To 7
    If Cells(lRowLoop, 5) <> "" Then
        sText = sText & Cells(lRowLoop, lColLoop) & Chr(10) & Chr(10)
    Next lColLoop

    objTextStream.writeline (Left(sText, Len(sText) - 1))


    objTextStream.Close
    Set objTextStream = Nothing
    Set fs = Nothing

End If
lRowLoop

End Sub