Tabloyu Worde Aktarma

[Hsn55]

Merhabalar;
Ekli dosyada talep sayfasındaki C7:F62 hücre aralığındaki tüm verileri biçimlenmiş hali ile buton ile word belgesine aktarabilir miyiz. Ancak;
1-Veriler aktarıldıktan sonra word belgesi açık kalacak.
2-C12:C62 hücresinde sadece dolu satırlar biçimlenmiş hali ile aktarılacak.
Destek ve yardımınızı bekliyorum. Saygılarımla

https://dosyam.org/1Pjx/AKTAR.xlsx

 

[Hsn55]

Merhabalar;
Konuya yardımcı olabilir misiniz

 

[hamitcan]

Aşağıdaki gibi deneyebilirsiniz.
Kaynak: Copy worksheet information to Word using VBA in Microsoft Excel (exceltip.com)

Sub CopyWorksheetsToWord()
' requires a reference to the Word Object library:' --- Comment
' in the VBE select Tools, References and check the Microsoft Word X.X object library' --- Comment

'Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet
Application.ScreenUpdating = False
Application.StatusBar = "Creating new document..."


Set wdApp = CreateObject("Word.Application") 'çalışıyor
'Set wdApp = GetObject(, "Word.Application") 'çalışıyor
Set wdDoc = wdApp.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
    Application.StatusBar = "Copying data from " & ws.Name & "..."
    ws.UsedRange.Copy ' or edit to the range you want to copy' --- Comment
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
    Application.CutCopyMode = False
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
    ' insert page break after all worksheets except the last one' --- Comment
    If Not ws.Name = Worksheets(Worksheets.Count).Name Then
        With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
            .InsertParagraphBefore
            .Collapse Direction:=wdCollapseEnd
            .InsertBreak Type:=wdPageBreak
        End With
    End If
Next ws

Set ws = Nothing

Application.StatusBar = "Cleaning up..."
' apply normal view' --- Comment
With wdApp.ActiveWindow
    If .View.SplitSpecial = wdPaneNone Then
        .ActivePane.View.Type = wdNormalView
    Else
        .View.Type = wdNormalView
    End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False
End Sub

 

[Hsn55]

Hamit bey şu makroda hata verdi
.ActivePane.View.Type = wdNormalView

 

[hamitcan]

Word referansını eklediniz mi ?

 

[halit3]

Alternatif kod
Keşke bir tanede örnek word dosyası ekleseydiniz.

Sub deneme()

son = Cells(Rows.Count, "c").End(3).Row

Range(Cells(7, "c"), Cells(son, "f")).Copy

Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add
wrdApp.Visible = True
wrdApp.ActiveDocument.Range.Paste

Application.DisplayAlerts = False
sat1 = CreateObject("Scripting.FileSystemObject").getfolder(ThisWorkbook.Path).Files.Count + 1
dosya_adi = ThisWorkbook.Path & "\" & "word dosya " & sat1 & ".doc"
wrdApp.ActiveDocument.SaveAs dosya_adi

'wrdDoc.Close
'wrdApp.Quit SaveChanges:=wdSaveChanges
 Application.CutCopyMode = False
MsgBox "işlem tamam"
End Sub

 

[Hsn55]

Sayın Hamit bey ve sayın Halit bey çok teşekkür ederim. Kodlar işime yaradı. Ellerinize sağlık