Çözüldü vba il excel dosyasından word'e seçilen alanı metin olarak aktarma

[emrahyzz]

merhaba;

üstat mancubus aşağıdaki kodu farklı bir konuda çözüm olarak oluşturmuş eline sağlık güvenilir olarak çalışıyor, lakin benim hazırladığım çalışmaya bir türlü uyarlayamadım yardımlarınızı beklediğim konu aşağıdaki kodun "excel'in istenilen sayfa içerisinde istenilen aralıktaki görünen hücreleri (gizli satırlar hariç) metin olarak word dosyasının içerisine alması", çalışmanın sonuna geldim ve bu aşamada takılıp kaldım yardımlarınız bekliyorum.

"malesef örnek dosya yükleyemiyorum"

Sub Excel_Sayfalarini_Word_Dokumani_Yap()
    
    Dim appWord As Word.Application
    Dim docWord As Word.Document
    Dim fPath As String, fName As String
    Dim i As Long, j As Long, calc As Long, LastRow As Long
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With
    
    fPath = ThisWorkbook.Path & "\"
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        With Worksheets(i)
            fName = .Name
            LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            For j = LastRow To 1 Step -1
                .Rows(j).Hidden = .Cells(j, 1) = 0
            Next j
            .UsedRange.Copy
        End With
        Set appWord = New Word.Application
        With appWord
            .Visible = True
            Set docWord = .Documents.Add
            With docWord
                .Content.Paste
                .SaveAs fPath & fName & ".docx", FileFormat:=wdFormatDocumentDefault
                .Close
            End With
            .Quit
        End With
        Set wrdDoc = Nothing
        Set wrdApp = Nothing
        With Worksheets(i)
            LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            For j = LastRow To 1 Step -1
                If .Rows(j).Hidden = True Then .Rows(j).Hidden = False
            Next j
        End With
    Next i
    
    With Application
        .Calculation = calc
        .CutCopyMode = False
    End With

End Sub

 

[mancubus]

Sub Excel_Sayfasindaki_Sütunda_Filtrelenen_Verileri_Word_Dokumani_Yap()
'VBE'de Tools / References'dan Microsoft Word XX.0 object Library işaretlenmelidir.

    Dim appWord As Word.Application, docWord As Word.Document
    Dim fPath As String, fName As String
   
    fPath = ThisWorkbook.Path & "\"
   
    With Sheets("Sayfa2")
        fName = .Name
        .Range("A1:A150").SpecialCells(xlCellTypeVisible).Copy
    End With

    Set appWord = New Word.Application
    With appWord
        .Visible = True
        Set docWord = .Documents.Add
        With docWord
            .Paragraphs(1).Range.PasteSpecial Link:=False, Placement:=wdInLine, DataType:=wdPasteText
            .SaveAs fPath & fName & ".docx", FileFormat:=wdFormatDocumentDefault
            '.Close
        End With
        '.Quit
    End With
   
    Application.CutCopyMode = False

End Sub