• Combine / import / copy / merge Excel workbooks into a single workbook using VBA programatically

• Creating an Index with hyperlinks to all worhsheets in an excel workbook using VBA

• Split a MS word document at Section Breaks into individual documents using word VBA

Combine / import / copy / merge Excel workbooks into a single workbook using VBA programatically

'Code by Mahipal Padigela
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Reference "Microsoft scripting runtime" object library (Excel-->Alt+F11-->Tools-->References)
'Replace "C:\test\" with your folder path including the trailing slash.
'In the newly created workbooks, the sheet names are prefixed with their workbook(excel file) names.
'Paste the following code into code window
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub import()

Dim fso As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Dim strPath As String
Dim intDefaultSheets As Integer
Dim strFilename As String
Dim strSheetname As String
Dim strOutFile As String
Dim i As Integer
Dim j As Integer

Dim sh As Worksheet

i = 1
j = 1

strPath = "C:\test\"
strOutFile = "allworkbooks.xls"

Set myFolder = fso.GetFolder(strPath)

'suppress any alerts by excel
Application.DisplayAlerts = False

Workbooks.Add
ActiveWorkbook.Sheets(Array("Sheet2", "Sheet3")).Delete
ActiveWorkbook.SaveAs strPath & strOutFile

For Each myFile In myFolder.Files
    If myFile.Name <> strOutFile Then
         strFilename = Left(Replace(myFile.Name, " ", ""), Len(Replace(myFile.Name, " ", "")) - 4)
         Workbooks.Open myFile
        
         For i = 1 To Workbooks(myFile.Name).Sheets.Count
             strSheetname = Replace(Workbooks(myFile.Name).Sheets(i).Name, " ", "")
             Workbooks(myFile.Name).Sheets(i).Name = strFilename & "_" & strSheetname
             Workbooks(myFile.Name).Sheets(i).Copy After:=Workbooks(strOutFile).Sheets(j)
             j = j + 1
             strSheetname = ""
         Next i
         Workbooks(myFile.Name).Close False
        strFilename = ""
    End If
Next myFile

Application.DisplayAlerts = True

Set myFile = Nothing
Set myFolder = Nothing
Set fso = Nothing

MsgBox "done"
End Sub

Top

Creating an Index with hyperlinks to all worhsheets in an excel workbook using VBA

'Code by Mahipal Padigela
'code creates hyperlinks in an excel file 
'Open Microsoft Excel,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Replace the file paths where necessory to suit yours
'Close VB Editor and run this Macro from Excel window(Alt+F8)

Sub CreateIndex()
 Dim strTemp As String
 Dim strRow As String
 Dim sh As Worksheet
 Dim j As Integer
    
  Workbooks.Open "H:\f\allworkbooks.xls"
  ActiveWorkbook.Sheets(1).Activate
  ActiveWorkbook.Sheets.Add
  ActiveWorkbook.Sheets(1).Name = "Index"
  ActiveWorkbook.Sheets(1).Range("A1") = "Index"
  ActiveWorkbook.Sheets(1).Range("A1").Font.Bold = True
  ActiveWorkbook.Sheets(1).Range("A1").Font.Underline = True
 
'build index on the 1st sheet
  j = 1
  For j = 2 To ActiveWorkbook.Sheets.Count
     ActiveWorkbook.Sheets("index").Cells(j, 1).Value = ActiveWorkbook.Sheets(j).Name
     strTemp = "'" & Sheets(j).Name & "'!A1"
     Range("A" & j).Select
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=strTemp
  Next

'add "Back to Index" hyperlinks on each sheet
  For Each sh In ActiveWorkbook.Sheets
     If sh.Index <> 1 Then
        sh.Activate
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown
        Range("A1") = "Back To Index"
        strTemp = "'" & Sheets(1).Name & "'!A1"
        Range("A1").Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=strTemp
        End If
  Next sh
  ActiveWorkbook.Sheets(1).Activate
  ActiveWorkbook.Sheets("index").Range("A:A").EntireColumn.AutoFit
  
  MsgBox "done"
  
End Sub

Top

Split a MS word document at Section Breaks into individual documents using word VBA

'Code by Mahipal Padigela
'Open Microsoft Word,then goto Visual Basic Editor(Alt+F11) and Insert a Module
'Paste the following code into code window
'Replace the file paths where necessory to suit yours
'Close VBA Editor and run this Macro from the Word window(Alt+F8)
'Note: Make sure you have a few Section Breaks in your document to test the code
Sub Generate()
 Dim rng As Range
 Dim strName As String
 Dim strSource As String
 Dim strFileTitle As String
 Dim i As Integer

 i = 1
 strSource = "C:\test.doc"
 strFileTitle = "test.doc"

 Application.ScreenUpdating = False

 Documents.Open strSource 'open the word document

 For i = 1 To ActiveDocument.Sections.Count

    Set rng = ActiveDocument.Sections(i).Range
    rng.Copy    'copy the paragraph
    
    Documents.Add  'create a new word document
    Selection.Paste 'paste into the new document
    
    ActiveDocument.Sentences(1).Select ' select 1st line for filename
    
    strName = Selection.Sentences(1).Text
    strName = Replace(strName, Chr(13), "") 'replace enter key if any
    strName = Replace(strName, Chr(9), "") 'replace tab chars if any
    strName = Replace(strName, Chr(10), "") 'replace newline chars if any
    strName = Trim(Replace(strName, ":", "")) & ".doc" 'replace any colons and trim the string
    
    ActiveDocument.SaveAs "C:\" & strName   'save the new document
    ActiveDocument.Close                    'close the document
    Windows(strFileTitle).Activate          'switch to the main document window
    
 Next i

 Windows(strFileTitle).Close
 Application.ScreenUpdating = True
 Set rng = Nothing
End Sub

Top