hi Noorain,
thanks alot.I haven't tried this.Before trying, i would like to ask some
queries.I'm not too good in macros...will this macro reduce the size of
files placed at share drive or should i open all files on share drive &
then run this macro at my end??? Please clear my doubts on it.
Thanks
On Thursday, July 5, 2012 6:46:25 PM UTC+5:30, NOORAIN ANSARI wrote:
> Dear SG.
>
> Please try it..
>
>
>
> Option Explicit
> Sub SHRINK_EXCEL_FILE_SIZE()
>
> Dim WSheet As Worksheet
> Dim CSheet As String 'New Worksheet
> Dim OSheet As String 'Old WorkSheet
> Dim Col As Long
> Dim ECol As Long 'Last Column
> Dim lRow As Long
> Dim BRow As Long 'Last Row
> Dim Pic As Object
>
> For Each WSheet In Worksheets
> WSheet.Activate
> 'Put the sheets in a variable to make it easy to go back and
> forth
> CSheet = WSheet.Name
> 'Rename the sheet to its name with _Delete at the end
> OSheet = CSheet & "_Delete"
> WSheet.Name = OSheet
> 'Add a new sheet and call it the original sheets name
> Sheets.Add
> ActiveSheet.Name = CSheet
> Sheets(OSheet).Activate
> 'Find the bottom cell of data on each column and find the
> further row
> For Col = 1 To Columns.Count 'Find the actual last bottom row
> If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
> BRow = Cells(Rows.Count, Col).End(xlUp).Row
> End If
> Next
>
> 'Find the end cell of data on each row that has data and find
> the furthest one
> For lRow = 1 To BRow 'Find the actual last right column
> If Cells(lRow, Columns.Count).End(xlToLeft).
> Column > ECol Then
> ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
> End If
> Next
>
> 'Copy the REAL set of data
> Range(Cells(1, 1), Cells(BRow, ECol)).Copy
> Sheets(CSheet).Activate
> 'Paste Every Thing
> Range("A1").PasteSpecial xlPasteAll
> 'Paste Column Widths
> Range("A1").PasteSpecial xlPasteColumnWidths
>
> Sheets(OSheet).Activate
> For Each Pic In ActiveSheet.Pictures
> Pic.Copy
> Sheets(CSheet).Paste
> Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
> Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
> Next Pic
> Sheets(CSheet).Activate
>
> 'Reset the variable for the next sheet
> BRow = 0
> ECol = 0
> Next WSheet
>
> ' Since, Excel will automatically replace the sheet references for
> you on your formulas,
> ' the below part puts them back.
> ' This is done with a simple replace, replacing _Delete with nothing
> For Each WSheet In Worksheets
> WSheet.Activate
> Cells.Replace "_Delete", ""
> Next WSheet
>
> 'Roll through the sheets and delete the original fat sheets
> For Each WSheet In Worksheets
> If Not Len(Replace(WSheet.Name, "_Delete", "")) =
> Len(WSheet.Name) Then
> Application.DisplayAlerts = False
> WSheet.Delete
> Application.DisplayAlerts = True
> End If
> Next
> End Sub
>
> http://www.excelitems.com/2010/11/shrink-reduce-excel-file-size.html
>
> --
> Thanks & regards,
> Noorain Ansari
> www.noorainansari.com
> www.excelmacroworld.blogspot.com
>
> On Thu, Jul 5, 2012 at 6:09 PM, SG <sonal...@gmail.com> wrote:
>
>> Hi Experts,
>>
>> I'm in crunch situation.Let me try to explain.We have some Excel files
>> named-1,2 & 3 saved on network share of pune & they are really very heavy
>> like 40 MB each. What i have to do is to fetch the data of current week for
>> eg. week-27.I have analysed them & the trend of data is irregular i.e you
>> have the Current week data in all the files.Each files takes so much of
>> time to get open.Then, i put weeknum function in the file & copy the data
>> at my end.Please suggest any solution(if any macro) if it can be resolved.
>>
>> Thanks
>> SG
>>
>> --
>> FORUM RULES (986+ members already BANNED for violation)
>>
>> 1) Use concise, accurate thread titles. Poor thread titles, like Please
>> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice
>> will not get quick attention or may not be answered.
>>
>> 2) Don't post a question in the thread of another member.
>>
>> 3) Don't post questions regarding breaking or bypassing any security
>> measure.
>>
>> 4) Acknowledge the responses you receive, good or bad.
>>
>> 5) Cross-promotion of, or links to, forums competitive to this forum in
>> signatures are prohibited.
>>
>> NOTE : Don't ever post personal or confidential data in a workbook. Forum
>> owners and members are not responsible for any loss.
>>
>>
>> ------------------------------------------------------------------------------------------------------
>> To post to this group, send email to excel-macros@googlegroups.com
>>
>> To unsubscribe, send a blank email to
>> excel-macros+unsubscr...@googlegroups.com
>
>
>
>
>
>
>
>
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
