Excel macro - running through cells on the same level - excel

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

Answer 2

not quite sure I understand the prob ... but here's a stab at it:
dim rg200x3 as range: set rg200x3 = range("a1:c200")
dim Col1 as new collection
dim Col2 as new collection
dim Col3 as new collection
dim rgRow as new range
dim sText as string
for each rgRow in rg200x3
sText = trim(rgRow.cells(1,1)): if (sText <> "") call Col1.Add(sText)
sText = trim(rgRow.cells(1,2)): if (sText <> "") call Col2.Add(sText)
sText = trim(rgRow.cells(1,3)): if (sText <> "") call Col3.Add(sText)
next rgRow
at this point Col1, Col2, and Col3 contain your text w the blank cells factored out, so now loop over these to print out
dim i as long
for i = 1 to 200
on error resume next ' (cheap way to avoid checking if index > collection sz)
debug.print Col1(i) + " | " Col2(i) + " | " + Col3(i)
on error goto 0
next i
(note: code typed in freehand with no checking ... )

Answer 3

How about this to sub for your first solution:
iMaxRow = 200
" Loop through columns and rows"
For iRow = 1 To iMaxRow
For iCol = 1 To 3
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 iCol
Next iRow