Question

So I want to run through A1-C200 and paste everything into a Word document. The trouble is, I have two ways of pasting it into Word, but each one has its downfall.

Goal: Copy A1-C200 into Word and keep the column layout, without copying blancs.

Example 1:

The code below copies everything into Word, but runs from A1 -> A200, B1 -> B200, C1 -> C200. Because it reads through my file this way, I lose my column layout. I would prefer a solution for this example, because this code looks clearer to me.

iMaxRow = 200

" Loop through columns and rows"
For iCol = 1 To 3
    For iRow = 1 To iMaxRow

    With Worksheets("GreatIdea").Cells(iRow, iCol)
        " Check that cell is not empty."
        If .Value = "" Then
            "Nothing in this cell."
            "Do nothing."
        Else
            " Copy the cell to the destination"
            .Copy
            appWD.Selection.PasteSpecial
        End If
    End With

    Next iRow
Next iCol

Example 2:

The code below copies the correct column layout, but also inserts blancs. So if A1-A5 and A80-A90 are filled in, I will have 75 blancs in my Word document.

a1 = Range("A1").End(xlDown).Address
lastcell = Range("C1").Address
Range(a1, lastcell).Copy
With Range("A1") 
Range(.Cells(1, 1), .End(xlDown).Cells(2, 3)).Copy
End With
Range("A1:C50").Copy
appWD.Selection.PasteSpecial

Answer 1

There’s multiple ways to do this, don’t know which is the quickest but here’s some code I threw together real quick for you. Getting the range all at once in a variant is the fastest way to grab data out of excel.

Sub test()

        Dim i As Long, j As Long
        Dim wd As Word.Document
        Dim wdTable As Word.Table
        Dim wks As Excel.Worksheet
        Dim v1 As Variant
        Set wd = GetObject("C:\Documents and Settings\Jon\Desktop\New Microsoft Word Document.doc")

'Get data in array
        Set wks = ActiveSheet
        v1 = wks.UsedRange        

'Create table
        Set wdTable = wd.Tables.Add(Range:=wd.Application.Selection.Range, NumRows:=1, NumColumns:= _
            ubound(v1,2), DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
            wdAutoFitFixed)


        'Place data
        For i = 1 To UBound(v1)
            For j = 1 To UBound(v1, 2)
                If Len(v1(i, j)) > 0 Then
                    'Add row if not enough rows, this can be done before the j loop if
                    'you know the first column is always filled.
                    'You can also do an advanced filter in excel if you know that the first
                    'column is filled always and filter for filled cells then just
                    'do a straight copy and paste using r1.specialcells(xlCellTypeVisible).copy 
                    'If you know the rows ahead of time when you create the table you can create all the rows at once,
                     'which should save time.
                    wd.application.selection
                    If wdTable.Rows.Count < i Then wdTable.Rows.Add
                    wdTable.Cell(i, j).Range.Text = v1(i, j)
                End If
            Next j
        Next i

        Set wks = Nothing: Set wd = Nothing: Set v1 = Nothing
    End Sub