I have an excel sheet that has data in row A. I am trying to move all the data into two columns in word.
The first column is working perfectly and will put all the data in it. The second column however puts the same data in all rows and runs through every row in the excel spread sheet. Can someone explain to me why this is happening?
here is the entire code, I have bolded the section that I am having some trouble with
Sub Drawings()
Dim WordApp As Word.Application
Dim oDoc As Word.Document
Dim myRange As Word.Range
Dim RowCount
Dim RowNumber
Dim Row
RowCount = Application.CountA(Range("A:A"))
RowNumber = Round(RowCount / 2)
Set WordApp = CreateObject("Word.Application") ' creates the Woord Applications
WordApp.Visible = True ' allows the word window to be open
Set oDoc = WordApp.Documents.Add ' WordDoc is the variable to edit the document
Set otable = oDoc.Tables.Add( _
Range:=oDoc.Range(Start:=0, End:=0), NumRows:=RowNumber + 1, _
NumColumns:=3) ' adds a table with three columns and spe
oDoc.Tables(1).Columns(1).SetWidth ColumnWidth:=WordApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 1 to 4 inches
oDoc.Tables(1).Columns(2).SetWidth ColumnWidth:=WordApp.InchesToPoints(0.19), RulerStyle:=wdAdjustNone ' sets column 2 to .2 inches
oDoc.Tables(1).Columns(3).SetWidth ColumnWidth:=WordApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 3 to 4 inches
With otable
.Rows.HorizontalPosition = WordApp.InchesToPoints(-0.75) ' shifts labels left on the page
End With
'Loop through columns and rows
For iRow = 1 To RowNumber
For iCol = 1 To 1 ' takes data from column 1
With Worksheets("Sheet1").Cells(iRow, iCol)
otable.Rows(iRow).Cells(1).Range.Text = .Value
End With
Next iCol
Next iRow
For iRow = RowNumber + 1 To RowCount
For iCol = 1 To 1 ' takes data from column 1
For Row = 1 To RowNumber
With Worksheets("Sheet1").Cells(iRow, iCol)
otable.Rows(Row).Cells(3).Range.Text = .Value
End With
Next Row
Next iCol
Next iRow
WordApp.Selection.WholeStory ' selects the entire table
WordApp.Selection.Font.Bold = wdToggle ' bolds the text
WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center aligns everything
WordApp.Selection.Font.Size = 14
oDoc.Tables(1).Rows.HeightRule = wdRowHeightExactly ' ensures row height is exact
oDoc.Tables(1).Rows.Height = WordApp.InchesToPoints(1) ' sets all rows to 1 inch
End Sub
Thanks!