Sub MultiReplace2()
Application.ScreenUpdating = False
    Dim StrFind As String, StrRepl As String, i As Long
    StrFind = "-Ge,-Ex,-Le,-Nu,-De,-Jo,-Ju,-Ru,-1Sa,-2Sa,-1Ki,-2Ki,-1Ch,-2Ch,-Ez,-Ne,-Es,-Jo,-Ps,-Pr,-Ec,-So,-Is,-Je,-La,-Ez,-Da,-Ho,-Jo,-Am,-Ob,-Jo,-Mi,-Na,-Ha,-Ze,-Ha,-Ze,-Ma,-Mt,-Mk,-Lk,-Jn,-Ac,-Ro,-1Co,-2Co,-Ga,-Ep,-Ph,-Co,-1Th,-2Th,-1Ti,-2Ti,-Ti,-Ph,-He,-Ja,-1Pe,-2Pe,-1Jn,-2Jn,-3Jn,-Ju,-Re"
    StrRepl = "- Genesis,- Exodus,- Leviticus,- Numbers,- Deuteronomy,- Joshua,- Judges,- Ruth,- 1 Samuel,- 2 Samuel,- 1 Kings,- 2 Kings,- 1 Chronicles,- 2 Chronicles,- Ezra,- Nehemiah,- Esther,- Job,- Psalm,- Proverbs,- Ecclesiastes,- Song of Solomon,- Isaiah,- Jeremiah,- Lamentations,- Ezekiel,- Daniel,- Hosea,- Joel,- Amos,- Obadiah,- Jonah,- Micah,- Nahum,- Habakkuk,- Zephaniah,- Haggai,- Zechariah,- Malachi,- Matthew,- Mark,- Luke,- John,- Acts,- Romans,- 1 Corinthians,- 2 Corinthians,- Galatians,- Ephesians,- Philippians,- Colossians,- 1 Thessalonians,- 2 Thessalonians,- 1 Timothy,- 2 Timothy,- Titus,- Philemon,- Hebrews,- James,- 1 Peter,- 2 Peter,- 1 John,- 2 John,- 3 John,- Jude,- Revelation"
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .MatchWholeWord = True
        .Wrap = wdFindContinue
        For i = 0 To UBound(Split(StrFind, ","))
            .Text = Split(StrFind, ",")(i)
            .Replacement.Text = Split(StrRepl, ",")(i)
            .Execute Replace:=wdReplaceAll
        Next i
    End With
Application.ScreenUpdating = True
End Sub