旅程表の地名と地名の間に二重線を引くマクロを作成するには?

Question 94.3   Previous Next
はじめまして、ホームページ、いつも参考にさせていただいてます。
旅行の行程表を作成するのですが、地名と地名の間に二重線を引きたいのですが、コピー、貼り付けですと、セルの真ん中に貼り付けにならないです
初心者で思いが伝わらないと思いますがよろしくお願いします。

もう少し補足させてください。
Private Sub CommandButton1_Click()
  コース登録.Show
End Sub
で入力画面(ユーザーフォーム)を開き、そこへ出発地、経由地、目的地などを入力して[登録]ボタンを押すと、上図のようなワークシートが作成されるところまでできています。
このときに、柳川市、八女IC、太宰府IC、Yahooドームの間に二重線を自動で記入出来たらと思いました。
すみません、よろしくお願い致します。
Answer   Copyright (C) 2009.4.2 永井善王
下図のようにしたいのですね。 提示された与件に限ってなら下記マクロで可能です。
あとは応用ですから頑張ってください。
'------------------------------
Sub 二重線を描く()
    始点X = 55
    始点Y = 11.25
    終点X = 107
    終点Y = 始点Y
    太さ = 3#
    実線点線 = msoLineSolid
    スタイル = msoLineThinThin
    線の色 = 64
    ActiveSheet.Shapes.AddLine(始点X, 始点Y, 終点X, 終点Y).Select
    Selection.ShapeRange.Line.Weight = 太さ
    Selection.ShapeRange.Line.DashStyle = 実線点線
    Selection.ShapeRange.Line.Style = スタイル
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 線の色
    二重線をコピーする
End Sub
'------------------------------------------------------------------------------
Private Sub 二重線をコピーする()
    Range("B1").Copy
    右端列 = Range(Cells(1, Columns.Count), Cells(1, Columns.Count)). _
        End(xlToLeft).Column
    For 列 = 3 To 右端列
        If Range(Cells(1, 列), Cells(1, 列)).Value = "" Then
            Range(Cells(1, 列), Cells(1, 列)).Select
            ActiveSheet.Paste
        End If
    Next
    Application.CutCopyMode = False
End Sub
'------------------------------------------------------------------------------

 

Excel VBA Macro