Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-18-2015, 03:11 AM
Story11 Story11 is offline Copy tables and transpose them from Word to Excel Windows 7 64bit Copy tables and transpose them from Word to Excel Office 2013
Novice
Copy tables and transpose them from Word to Excel
 
Join Date: Jan 2015
Posts: 28
Story11 is on a distinguished road
Default Copy tables and transpose them from Word to Excel

Hello everyone!
I need to copy some tables from MS Word to Excel automatically with VBA. but I need the tables to be transposed in Excel. I've attached samples to this post so that you can understand what I mean.


I've tried some codes but they are not working like I want. I need this urgently please.
If someone is out there reading this and can help out, please do.
Save a soul here please!
Thank you in advance.
Attached Images
File Type: jpg Story - Screenshot.jpg (208.8 KB, 15 views)
Attached Files
File Type: docx Story - Word tables.docx (43.0 KB, 10 views)
File Type: xlsx Story - Excel output.xlsx (27.2 KB, 9 views)
Reply With Quote
  #2  
Old 01-18-2015, 06:40 AM
gmayor's Avatar
gmayor gmayor is offline Copy tables and transpose them from Word to Excel Windows 7 64bit Copy tables and transpose them from Word to Excel Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The following Word macro should work. Open the document with the tables and run the macro. You'll need to change the path (C:\Path) to the workbook:

Code:
Sub CopyTablesToExcel()
Dim xlApp As Object
Dim xlBook As Object
Dim oTable As Table
Dim NextRow As Long
Dim oCell As Range
Const strWorkBookName As String = "C:\Path\Story - Excel output.xlsx"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkBookName)
    xlApp.Visible = True
    For Each oTable In ActiveDocument.Tables
        NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
        Set oCell = oTable.Rows(1).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("A" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(2).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("B" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(3).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("C" & NextRow) = oCell.Text
        xlBook.Save
    Next oTable
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set oCell = Nothing
    Set oTable = Nothing
lbl_Exit:
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 01-18-2015, 07:28 AM
Story11 Story11 is offline Copy tables and transpose them from Word to Excel Windows 7 64bit Copy tables and transpose them from Word to Excel Office 2013
Novice
Copy tables and transpose them from Word to Excel
 
Join Date: Jan 2015
Posts: 28
Story11 is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
The following Word macro should work. Open the document with the tables and run the macro. You'll need to change the path (C:\Path) to the workbook:

Code:
Sub CopyTablesToExcel()
Dim xlApp As Object
Dim xlBook As Object
Dim oTable As Table
Dim NextRow As Long
Dim oCell As Range
Const strWorkBookName As String = "C:\Path\Story - Excel output.xlsx"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkBookName)
    xlApp.Visible = True
    For Each oTable In ActiveDocument.Tables
        NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
        Set oCell = oTable.Rows(1).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("A" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(2).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("B" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(3).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("C" & NextRow) = oCell.Text
        xlBook.Save
    Next oTable
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set oCell = Nothing
    Set oTable = Nothing
lbl_Exit:
    Exit Sub
End Sub
Thank you gmayor, I've even gotten one, I was able to reorganize my codes and it worked. i'm going to look through yours too so that I can add to my knowledge. Once again, thank you.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
need VBA to Transpose the Data from excel to word based on given criteria(status) winmaxservices2 Excel Programming 1 12-19-2014 10:21 PM
Copy tables and transpose them from Word to Excel Word macro: copy from different tables into one table adisl Word VBA 4 03-25-2014 02:40 AM
Copy tables and transpose them from Word to Excel Cannot Copy and Paste Word 2010 Tables jctech1943 Word 8 07-03-2012 04:16 AM
how to copy all ms word tables into excel rehan129 Word 0 01-28-2012 10:17 AM
Copy tables and transpose them from Word to Excel Excel Tables to MS Word ripcurlksm Word Tables 2 09-09-2011 04:59 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:43 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft