idnoidno
06-16-2017, 08:38 PM
Sub ttxx()
Dim oWord As Object
Dim vFiles
Dim iFile As Integer
Dim R As Range
Dim irow As Integer, i As Integer, j As Integer
vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
irow = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
'Set R = Worksheets.Add.Range("A1:a" & irow)
For iFile = LBound(vFiles) To UBound(vFiles)
oWord.Documents.Open vFiles(iFile)
oWord.ActiveDocument.tables(1).Select
With Selection
If irow > 1 Then
For i = 2 To .Rows.Count
For j = 1 To .Columns.Count
Cells(irow + i - 1, j) = WorksheetFunction.Clean(.cell(i, j).Range.Text)
Next j
Next i
Else
For irow = 1 To .Rows.Count
For j = 1 To .Columns.Count
Cells(i, j) = WorksheetFunction.Clean(.cell(i, j).Range.Text)
Next j
Next irow
End If
End With
oWord.ActiveDocument.Close False
Next
oWord.Quit
Set oWord = Nothing
ActiveSheet.Columns.AutoFit
End Sub
I am trying to import WORD table into EXCEL worksheet, but it can not work, please help me how to correct the wrong code?
Dim oWord As Object
Dim vFiles
Dim iFile As Integer
Dim R As Range
Dim irow As Integer, i As Integer, j As Integer
vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
irow = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
'Set R = Worksheets.Add.Range("A1:a" & irow)
For iFile = LBound(vFiles) To UBound(vFiles)
oWord.Documents.Open vFiles(iFile)
oWord.ActiveDocument.tables(1).Select
With Selection
If irow > 1 Then
For i = 2 To .Rows.Count
For j = 1 To .Columns.Count
Cells(irow + i - 1, j) = WorksheetFunction.Clean(.cell(i, j).Range.Text)
Next j
Next i
Else
For irow = 1 To .Rows.Count
For j = 1 To .Columns.Count
Cells(i, j) = WorksheetFunction.Clean(.cell(i, j).Range.Text)
Next j
Next irow
End If
End With
oWord.ActiveDocument.Close False
Next
oWord.Quit
Set oWord = Nothing
ActiveSheet.Columns.AutoFit
End Sub
I am trying to import WORD table into EXCEL worksheet, but it can not work, please help me how to correct the wrong code?