как исправить макрос?

[Nicolas_46]

Господа, у меня есть рабочий макрос, там все работает как надо.
работа макроса заключается в том, чтобы при замене значения в ячейке менялось значение в файле, причем макрос работает в автоматическом режиме (при снятии выделения с ячейки происходит запись в файл автоматически)

вопрос: как сделать чтобы макрос работал с кнопки, т.е. все значения из указанных ячеек записывались в файл не атоматически, а при нажатии кнопки.

заранее огромное спасибо.

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Target.Value <> "" Then
Select Case Target.Address

Case "$B$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 5, 5
 Case "$C$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 14, 5
Case "$D$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 23, 5
Case "$E$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 33, 5
Case "$F$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 43, 5
Case "$G$4"
 UdateDat Replace(Target.Text, ",", "."), 7, 52, 5


Case "$B$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 5, 4
 Case "$C$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 15, 4
Case "$D$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 24, 4
Case "$E$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 34, 4
Case "$F$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 44, 4
Case "$G$7"
 UdateDat Replace(Target.Text, ",", "."), 14, 53, 4


End Select

End If

End Sub

Private Sub UdateDat(s, St As Integer, Poz As Integer, Dlinna As Integer)
        On Error Resume Next
        Dim Path As String, X, strLine As String
        Path = ThisWorkbook.Path & "\IDSAPRK.DAT"
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oText = oFSO.OpenTextFile(Path, 1)
        strLine = oText.ReadAll
        oText.Close
        X = Split(strLine, vbCrLf, -1)
        Mid(X(St), Poz, Dlinna) = Space(2) & s & Space(Dlinna - 2 - Len(s))
        strLine = Join(X, vbCrLf)
        Set TextSave = oFSO.OpenTextFile(Path, 2)
        TextSave.Write strLine
        TextSave.Close
        Set oFSO = Nothing: Set TextSave = Nothing: Set oText = Nothing
End Sub

[doober]

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Target.Value <> "" Then

Заменить на

Private Sub CommandButton1_Click()
 Dim Target As Range
 Set Target = ActiveCell
'On Error Resume Next
If Target.Value <> "" Then

[Nicolas_46]

При замене, автоматическая запись убирается,
но при нажатии Run ничего не происходит.
даже не ругается. как быть?