https://github.com/cavo789/vba_excel_import_sheets
VBA macro for trying to retrieve worksheets in a corrupt Excel file
https://github.com/cavo789/vba_excel_import_sheets
excel macro vba-excel
Last synced: 4 months ago
JSON representation
VBA macro for trying to retrieve worksheets in a corrupt Excel file
- Host: GitHub
- URL: https://github.com/cavo789/vba_excel_import_sheets
- Owner: cavo789
- License: mit
- Created: 2018-02-26T14:50:41.000Z (about 7 years ago)
- Default Branch: master
- Last Pushed: 2021-11-01T21:56:14.000Z (over 3 years ago)
- Last Synced: 2024-11-28T23:34:04.407Z (5 months ago)
- Topics: excel, macro, vba-excel
- Language: VBA
- Size: 130 KB
- Stars: 2
- Watchers: 3
- Forks: 0
- Open Issues: 0
-
Metadata Files:
- Readme: readme.md
- License: LICENSE
Awesome Lists containing this project
- jimsghstars - cavo789/vba_excel_import_sheets - VBA macro for trying to retrieve worksheets in a corrupt Excel file (VBA)
README
# Excel - Import sheets
## Situation
Sometimes, Excel doesn't want anymore to open a file : even when trying to open it with `open and repair`, nothing happens.
The file is probably corrupt but it would be really nice if you can retrieve (import) your worksheets from that corrupt file to a new one.
## Description
The VBA code below will try to :
- open the workbook (called `wb`)
- if success,
_ create a new workbook (called `wbNew`)
_ loop for all worksheets in `wb`
_ copy the sheet into `wbNew`
_ close `wb` \* activate `wbNew` so you can verify, ... and save it.
This VBA piece of code will only do that : try to retrieve worksheets so willn't retrieve modules, settings, names, charts, ...
```vbnet
Public Sub DoIt()
Dim sFileName As String
Dim wb As Workbook, wbNew As Workbook
Dim shSource As Worksheet, shTarget As Worksheet
sFileName = 'full-name-to-your-corrupt-file.xlsx'
If (Dir(sFileName) = "") Then
MsgBox "Sorry this file doesn't exists", vbCritical
Exit Sub
End If
Set wbNew = Application.Workbooks.Add
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Set wb = Workbooks.Open(Filename:=sFileName, UpdateLinks:=False, ReadOnly:=True)
If (wb Is Nothing) Then
MsgBox "Sorry the file seems to be corrupt, Workbooks.Open() has failed", vbCritical
Exit Sub
End If
For Each sh In wb.Worksheets
Application.StatusBar = "Import sheet [" & sh.Name & "] from [" & wb.Name & "]"
On Error Resume Next
Call sh.Copy(Before:=wbNew.Worksheets(wbNew.Worksheets.Count))
If Err.Number <> 0 Then
MsgBox "Error " & sh.Name & " : " & Err.Description, vbCritical
Err.Clear
End If
Next
Call wb.Close(SaveChanges:=False)
Set wb = Nothing
wbNew.Activate
MsgBox "Sheets copied from " & sFileName & " to the current workbook", vbInformation
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
```