excelde yazılamn bilgileri worde aktar

[işsiz123]

merhaba arkadaşlar
aşağıdaki kodları ekteki dosya uydurmak istiyorum ama bir türlü yapamadım.

Private Sub CommandButton1_Click()
On Error Resume Next
txtsınıfı = ActiveCell.Offset(0, 0).Value
txtokulnumarası = ActiveCell.Offset(0, 1).Value
txttckimlikno = ActiveCell.Offset(0, 2).Value
txtadısoyadı = ActiveCell.Offset(0, 3).Value
txtveliadısoyadı = ActiveCell.Offset(0, 4).Value
txtadısoyadı2 = txtadısoyadı
txtbugün = CDate(Date)

ysn = Left(txtsınıfı, Len(txtsınıfı) - 2)

y_imi = Array("txtsınıfı", "txtokulnumarası", "txttckimlikno", "txtadısoyadı", "txtveliadısoyadı", "txtbugün", "txtadısoyadı2")
dizi = Array(txtsınıfı, txtokulnumarası, txttckimlikno, txtadısoyadı, txtveliadısoyadı, txtbugün, txtadısoyadı2)
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
If ysn = 5 Then
wd.Application.Documents.Open yol & "\" & "5.SINIF.doc"
Else
If ysn = 6 Then
wd.Application.Documents.Open yol & "\" & "6.SINIF.doc"
Else
If ysn = 7 Then
wd.Application.Documents.Open yol & "\" & "7.SINIF.doc"
Else
If ysn = 8 Then
wd.Application.Documents.Open yol & "\" & "8.SINIF.doc"
Else
MsgBox "SEÇTİĞİNİZ SINIFA AİT BİR DİLEKÇE ŞABLONU BULUNAMADI!", vbCritical
Exit Sub
End If
End If
End If
End If

For X = 0 To 6
wd.ActiveDocument.Bookmarks(y_imi(X)).Range.Select
wd.Selection = dizi(X)
wd.ActiveDocument.Bookmarks.Add Range:=wd.Selection.Range, Name:=y_imi(X)
Next

Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & txtadısoyadı & " - Dilekçe (" & CDate(Date) & ").doc"
End Sub

 

[işsiz123]

yardım edecek yok mu arkadaşlar