Copy dynamic range until value = 0

[TBR68]

Hello,

I can't find the ideal code to meet my needs.
I would like to copy the range of "A2:E..." according to the values of my "I" column.
In column "I" I will have either 1 or 0.

I would like a code that allows me to copy all the rows (from A2 to E...) at value 1 until the first row with a value of 0 in a dynamic way.

I am using this code now which will hide the rows with 0 values and then copy the rows and paste them into my Word file.

'Copy Overview page1
Sheets("Print_Content2").Select
'Hide rows when value = 0

    For Each c In Range("I2:I1000")
c.EntireRow.Hidden = c.Value = "0"
    Next


'Copy all rows with value 1 to Word bookmark

If ActiveSheet.Range("F2") = "1" Then
ActiveSheet.Range("A2:E1000").Copy
.Selection.Goto wdGoToBookmark, , , "OVER1"
.Selection.Paste
Else
'End If

Could you please help me to improve this code section to make it more smooth and safe?

Thanks a lot
TBR68

 

[davesexcel]

We would want to filter for 1 in column I then copy and paste to the word doc.

Sub copy_to_word()
    Dim sh As Worksheet
    Dim rng As Range
    Dim objWord As Object
    Set sh = ActiveSheet
    With sh
        .Range("A1").AutoFilter Field:=9, Criteria1:="1"
        Set rng = .Range("A1:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)

        Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.Documents.Open "C:\Users\davem\OneDrive\Excel Examples\Test.docx" ' change as required
        rng.Copy
       
        With objWord.ActiveDocument
            .Bookmarks("OVER1").Range.Paste
            .Save
            .Close

        End With
        objWord.Quit

        Application.CutCopyMode = 0
        If .AutoFilterMode = True Then .AutoFilterMode = False
    End With
   
End Sub

 

[TBR68]

We would want to filter for 1 in column I then copy and paste to the word doc.

Sub copy_to_word()
    Dim sh As Worksheet
    Dim rng As Range
    Dim objWord As Object
    Set sh = ActiveSheet
    With sh
        .Range("A1").AutoFilter Field:=9, Criteria1:="1"
        Set rng = .Range("A1:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)

        Set objWord = CreateObject("Word.Application")

        objWord.Visible = True

        objWord.Documents.Open "C:\Users\davem\OneDrive\Excel Examples\Test.docx" ' change as required
        rng.Copy
      
        With objWord.ActiveDocument
            .Bookmarks("OVER1").Range.Paste
            .Save
            .Close

        End With
        objWord.Quit

        Application.CutCopyMode = 0
        If .AutoFilterMode = True Then .AutoFilterMode = False
    End With
  
End Sub

Hello Dave,

Thanks for your reply,

I've tried to rework my code with your solution. FYI, my Word file is already open due to other copy and paste actions.
After multiple tries, I'm not able to make it work. Instead of copying the Excel range to my Word file, it removes the bookmark "OVER1" and keep the page empty. (see below)

=>

I'm able to copy datas from Excel to Work by using this kind of code (static so it's not what I would implement at the end):

''Copy Overview page2
ActiveSheet.Range("A18:C33").Copy
.Selection.Goto wdGoToBookmark, , , "OVER2"
.Selection.Paste

I really wish it would work with the statement With / End With as you've suggested.

        With objWord.ActiveDocument

            .Bookmarks("OVER1").Range.Paste
            
        End With

Maybe by using :
.Selection.Goto wdGoToBookmark, , , "OVER1" can work... somehow?

Thanks a lot

Thomas