Paste in Word with Numbering

[antonismouf]

Hello, I am using a macro that creates a Word document and pastes data from Excel in it. I would like two things:
1)Paste the data without the table, but keep the formatting
2)make the pasted data have numbering in the Word document

Could someone please help me with the properties to be added after the:

WdObj.Selection.PasteSpecial

Thanks in advance

 

[Macropod]

How about posting the rest of your code; a single line with no context is impossible to work with.

 

[antonismouf]

Sub WordUp()

Dim WdObj As Object, fname As String


fname = Sheets(2).[b1].Value


If fname <> "" Then 'make sure fname is not blank


    Set WdObj = CreateObject("Word.Application")
    
    WdObj.Visible = True
    
    finalrow = Sheets("Prosfora").Range("A9999").End(xlUp).Row
    Sheets("Prosfora").Range("A2:A" & finalrow).Copy
    
    WdObj.Documents.Open Filename:="C:\Users\User\Dropbox\ÐÑÏÃÑÁÌÌÁÔÁ\prosfora template1.docx"
    
    
    With WdObj
    
        .ChangeFileOpenDirectory "C:\Users\User\Dropbox\ÐÑÏÃÑÁÌÌÁÔÁ" 'save Dir
    
        .ActiveDocument.SaveAs Filename:="Ðñïóöïñá " & fname & ".doc"
        
    End With
    
    WdObj.Selection.PasteSpecial Link:=False ', DataType:=wdPasteText , Placement:=wdInLine, DisplayAsIcon:=False
    
    Application.CutCopyMode = False
    
    
    WdObj.ActiveDocument.Save
    Else:
    
    MsgBox ("ÐñïóèÝóôå ¼íïìá ÐåëÜôç")


End If




'With WdObj
'
'    .Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
'    .Selection.MoveUp Unit:=wdScreen, Count:=5, Extend:=wdExtend


'    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
'        .NumberFormat = "%1."
'        .TrailingCharacter = wdTrailingTab
'        .NumberStyle = wdListNumberStyleArabic
'        .NumberPosition = CentimetersToPoints(0.63)
'        .Alignment = wdListLevelAlignLeft
'        .TextPosition = CentimetersToPoints(1.27)
'        .TabPosition = wdUndefined
'        .ResetOnHigher = 0
'        .StartAt = 1
'        With .Font
'            .Bold = wdUndefined
'            .Italic = wdUndefined
'            .Strikethrough = wdUndefined
'            .Subscript = wdUndefined
'            .Superscript = wdUndefined
'            .Shadow = wdUndefined
'            .Outline = wdUndefined
'            .Emboss = wdUndefined
'            .Engrave = wdUndefined
'            .Allcaps = wdUndefined
'            .Hidden = wdUndefined
'            .Underline = wdUndefined
'            .Color = wdUndefined
'            .Size = wdUndefined
'            .Animation = wdUndefined
'            .DoubleStrikeThrough = wdUndefined
'            .Name = ""
'        End With
'        .LinkedStyle = ""
'    End With
'    ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
'    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(2)


'End With








'With WdObj


'    .ActiveDocument.Close


'    .Quit


'End With


Set WdObj = Nothing


End Sub

Commented is an attempt i made using the macro recorder in word

 

[Macropod]

Try:

Sub WordUp()
Dim WdApp As Object, WdDoc As Object, WdRng As Object, fldr As String, fname As String, finalrow As Long
fldr = "C:\Users\User\Dropbox\ÐÑÏÃÑÁÌÌÁÔÁ\"
fname = Sheets(2).[b1].Value
finalrow = Sheets("Prosfora").Range("A9999").End(xlUp).Row
If fname <> "" Then 'make sure fname is not blank
    Set WdApp = CreateObject("Word.Application")
    WdApp.Visible = True
    Set WdDoc = WdApp.Documents.Add(fldr & "prosfora template1.docx")
    With WdDoc
        Sheets("Prosfora").Range("A2:A" & finalrow).Copy
        Set WdRng = .Range.Characters.First.Paste
        WdRng.Tables(1).ConvertToText vbTab
        WdRng.ListFormat.ApplyOutlineNumberDefault
        .SaveAs fldr & "Ðñïóöïñá" & fname & ".docx", 12, , , False
    End With
    Application.CutCopyMode = False
Else
    MsgBox ("ÐñïóèÝóôå ¼íïìá ÐåëÜôç")
End If
Set WdRng = Nothing: Set WdDoc = Nothing: Set WdApp = Nothing
End Sub

There are many ways of applying numbering; I've chose one method. If that's not what you want, you should look at Word's Object Model and decide what you want to do (perhaps you have a particular paragraph Style that has numbering and you want to apply that).

 

[Macropod]

I have just read you post in https://www.mrexcel.com/forum/gener...-file-not-there-open-different-directory.html. It would have been better had you asked the related questions in the same thread.

After:
fldr = "C:\Users\User\Dropbox\ÐÑÏÃÑÁÌÌÁÔÁ"
Insert:
If Dir(fldr & "prosfora template1.docx") = "" Then fldr = "C:\Users\pc\Dropbox\ÐÑÏÃÑÁÌÌÁÔÁ"