Skip to main content
Code Golf

Return to Answer

corrected spacing
Source Link
Freedom
Freedom
  • 131
  • 4
Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(5055, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(5762, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(6469, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(3237, 1) = "(Ooh, give you up)"
.Cells(3338, 1) = .Cells(3237, 1)
.Cells(3439, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(3540, 1) = x & "," & x
.Cells(3641, 1) = "(Give you up)"
.Cells(3742, 1) = "(Ooh)"
.Cells(3843, 1).Resize(2, 1) = Cells(3540, 1).Resize(2, 1).Value
.Cells(4146, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(4752, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 10075
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
sp= ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & sp, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
sp= ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & sp, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(55, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(62, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(69, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(37, 1) = "(Ooh, give you up)"
.Cells(38, 1) = .Cells(37, 1)
.Cells(39, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(40, 1) = x & "," & x
.Cells(41, 1) = "(Give you up)"
.Cells(42, 1) = "(Ooh)"
.Cells(43, 1).Resize(2, 1) = Cells(40, 1).Resize(2, 1).Value
.Cells(46, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(52, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 75
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
sp= ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & sp, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
minor fix
Source Link
Freedom
Freedom
  • 131
  • 4
Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
Dim iu As Integer
Dim sf As String
Dim sp As String
Dim ro As Variant
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
srtPathandFilename =sp= ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & srtPathandFilenamesp, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
Dim iu As Integer
Dim sf As String
Dim sp As String
Dim ro As Variant
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
srtPathandFilename = ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & srtPathandFilename, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
sp= ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & sp, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
minor change to code
Source Link
Freedom
Freedom
  • 131
  • 4
Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
Dim iu As Integer
Dim sf As String
Dim sp As String
Dim ro As Variant
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close intUnitiu
srtPathandFilename = ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & srtPathandFilename, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
Dim iu As Integer
Dim sf As String
Dim sp As String
Dim ro As Variant
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close intUnit
srtPathandFilename = ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & srtPathandFilename, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub R()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "R"
With Sheets("R")
.Cells(1, 1) = "We're no strangers to love"
.Cells(2, 1) = "You know the rules and so do I"
.Cells(3, 1) = "A full commitment's what I'm thinking of"
.Cells(4, 1) = "you wouldn't get this from any other guy"
.Cells(5, 1) = "I just wanna tell you how I'm feeling"
.Cells(6, 1) = "Gotta make you understand"
g = "Never gonna"
.Cells(8, 1) = g & " give you up"
.Cells(9, 1) = g & " let you down"
.Cells(10, 1) = g & " run around and desert you"
.Cells(11, 1) = g & " make you cry"
.Cells(12, 1) = g & " say goodbye"
.Cells(13, 1) = g & " tell a lie and hurt you"
.Cells(23, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(30, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(50, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(57, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(64, 1).Resize(7, 1) = .Cells(8, 1).Resize(7, 1).Value
.Cells(15, 1) = "We've known each other for so long"
.Cells(16, 1) = "Your heart's been aching but"
.Cells(17, 1) = "you're too shy to say it"
.Cells(18, 1) = "Inside we both know what's been going on"
.Cells(19, 1) = "We know the game and we're gonna play it"
.Cells(20, 1) = "And if you ask me how I'm feeling"
.Cells(21, 1) = "Don't tell me you're too blind to see"
.Cells(32, 1) = "(Ooh, give you up)"
.Cells(33, 1) = .Cells(32, 1)
.Cells(34, 1) = "(Ooh)"
 x = "Never gonna give"
.Cells(35, 1) = x & "," & x
.Cells(36, 1) = "(Give you up)"
.Cells(37, 1) = "(Ooh)"
.Cells(38, 1).Resize(2, 1) = Cells(35, 1).Resize(2, 1).Value
.Cells(41, 1).Resize(5, 1) = Cells(15, 1).Resize(5, 1).Value
.Cells(47, 1).Resize(2, 1) = Cells(5, 1).Resize(2, 1).Value
End With
Dim iu As Integer
Dim sf As String
Dim sp As String
Dim ro As Variant
sf = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".xlsm") - 1) & Format(Now(), "_YYYY_MM_DD") & Format(Now(), "_HH_MM_SS") & ".txt"
iu = FreeFile
Open ThisWorkbook.Path & "\" & sf For Output As #iu
    With Sheets("R")
    For rr = 1 To 100
        Print #iu, .Cells(rr, 1).Text
    Next
    End With
    Close iu
srtPathandFilename = ThisWorkbook.Path & "\" & sf
ro = Shell("notepad.exe " & srtPathandFilename, vbNormalFocus)
    Sheets("R").Select
    ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Source Link
Freedom
Freedom
  • 131
  • 4