S
Steven
I have a macro that does find actual used range from a worksheet, and
copy/paste into newly created word document.
But I am having a error saying "user defined not defined"
please..
Thank you for taking time to read this.
Sub MyUsedRange()
Dim ar As Range, r As Double, c As Integer, tr As Double, tc As Integer
Dim ur As Range, fr As Double, fc As Integer, tfr As Double, tfc As
Integer
On Error Resume Next
fc = ActiveSheet.Columns.Count
fr = ActiveSheet.Rows.Count
Set ur =
Union(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants), _
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas))
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
End If
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
If Err.Number = 0 Then
For Each ar In ur.Areas
'tr = ar.Range("A1").Row + ar.Rows.Count - 1
tr = (ar.Range("A1").Row + 17) + ar.Rows.Count - 1
'tc = ar.Range("A1").Column + ar.Columns.Count - 1
tc = ar.Range("A1").Column - 1 + ar.Columns.Count - 1
If tc > c Then c = tc
If tr > r Then r = tr
tfr = ar.Range("A1").Row
'tfc = ar.Range("A1").Column
tfc = ar.Range("A1").Column - 1
If tfc < fc Then fc = tfc
If tfr < fr Then fr = tfr
Next
Range(Cells(fr, fc), Cells(r, c)).Select
ElseIf Err.Number = 1004 Then
'Range("A1").Select
End If
End Sub
Sub PasteTableToWord()
Dim obj As Word.Application
'Activate the worksheet
Worksheets("sheet9").Activate
'Select the range of cells to copy
'Worksheets("sheet1").Range("a1:c10").Copy
Call MyUsedRange
'Create a word object
Set obj = CreateObject("Word.Application.11")
'Make Word visible
obj.Visible = True
'Create a new file.
Set newDoc = obj.Documents.Add
'Determine if Microsoft Excel is running on the Macintosh or
Windows.
''If (Application.OperatingSystem Like "*Mac*") Then
'AppActivate "Microsoft word"
'obj.Selection.PasteSpecial 'Paste data into Word
''Else 'If Windows NT/95/3.x - paste data into Word
obj.Selection.PasteSpecial
''End If
'Format table
''obj.Selection.Tables(1).AutoFormat Format:=wdTableFormatGrid1
'Save the file
newDoc.SaveAs Filename:="C:\TestDoc.doc"
'Quit Word
obj.Quit
'Release object
Set obj = Nothing
End Sub
copy/paste into newly created word document.
But I am having a error saying "user defined not defined"
please..
Thank you for taking time to read this.
Sub MyUsedRange()
Dim ar As Range, r As Double, c As Integer, tr As Double, tc As Integer
Dim ur As Range, fr As Double, fc As Integer, tfr As Double, tfc As
Integer
On Error Resume Next
fc = ActiveSheet.Columns.Count
fr = ActiveSheet.Rows.Count
Set ur =
Union(ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants), _
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas))
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
End If
If Err.Number = 1004 Then
Err.Clear
Set ur = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
If Err.Number = 0 Then
For Each ar In ur.Areas
'tr = ar.Range("A1").Row + ar.Rows.Count - 1
tr = (ar.Range("A1").Row + 17) + ar.Rows.Count - 1
'tc = ar.Range("A1").Column + ar.Columns.Count - 1
tc = ar.Range("A1").Column - 1 + ar.Columns.Count - 1
If tc > c Then c = tc
If tr > r Then r = tr
tfr = ar.Range("A1").Row
'tfc = ar.Range("A1").Column
tfc = ar.Range("A1").Column - 1
If tfc < fc Then fc = tfc
If tfr < fr Then fr = tfr
Next
Range(Cells(fr, fc), Cells(r, c)).Select
ElseIf Err.Number = 1004 Then
'Range("A1").Select
End If
End Sub
Sub PasteTableToWord()
Dim obj As Word.Application
'Activate the worksheet
Worksheets("sheet9").Activate
'Select the range of cells to copy
'Worksheets("sheet1").Range("a1:c10").Copy
Call MyUsedRange
'Create a word object
Set obj = CreateObject("Word.Application.11")
'Make Word visible
obj.Visible = True
'Create a new file.
Set newDoc = obj.Documents.Add
'Determine if Microsoft Excel is running on the Macintosh or
Windows.
''If (Application.OperatingSystem Like "*Mac*") Then
'AppActivate "Microsoft word"
'obj.Selection.PasteSpecial 'Paste data into Word
''Else 'If Windows NT/95/3.x - paste data into Word
obj.Selection.PasteSpecial
''End If
'Format table
''obj.Selection.Tables(1).AutoFormat Format:=wdTableFormatGrid1
'Save the file
newDoc.SaveAs Filename:="C:\TestDoc.doc"
'Quit Word
obj.Quit
'Release object
Set obj = Nothing
End Sub