Hi guys,
This is very easy task.This VBA(Macro will help you to copy one excel workbook in new excel workbook.
just copy the code and paste in your VBA editor and run it
Set Sourcebook = Workbooks.Open(filepath.Text)
count = Sourcebook.Sheets.count
' COUNT THE TOTAL NUMBER OF SHEET IN SOURCE WORKBOOK
name = Sourcebook.namename = Replace(name, ".xls", "_temp")
'CREATE NEW WORKBOOK
Set Destibook = Workbooks.Add
' LOOP FOR COPY THE ALL DATA FROM SOURCE WORKBOOK TO DESTINATION WORKBOOK
For sht = 1 To count
If sht > 3 Then
Destibook.Sheets.Add after:=Sheets(Sheets.count)
' ADD NEW SHEET IN DESTINATION BOOK
End If
Set sh2 = Destibook.Sheets(sht)
Set sh1 = Sourcebook.Sheets(sht)
Destibook.Sheets(sht).name = Sourcebook.Sheets(sht).name
'ASSIGN THE SHEET NAME
With sh1
Set SourceRange = .Range("A1:" & RDB_Last(.Cells))
.Range("A1:" & RDB_Last(.Cells)).Copy
' COPY THE SELECTED DATA FROM SOURCE BOOK
End With
With sh2
.Range("A1 :" & RDB_Last(.Cells)).PasteSpecial xlPasteFormats
End With
With sh2
.Range("A1 :" & RDB_Last(.Cells)).PasteSpecial xlPasteValuesAndNumberFormats End With
Next
With Destibook
On Error Resume Next
.SaveAs Filename:=name
' SAVE THE DESTINATION BOOK IN SAME LOCATION WHERE THE SOURCE BOOK
End With
MsgBox " FILE IS CONVERTED SUCESSFULLY.."
End
----------------------------------------------------------------
'USER DEFINE FUNCTION SELECTING THE RANGE
Function RDB_Last(rng As Range)
Dim lrw As Long
Dim lcol As Integer
On Error Resume Next
lrw = rng.Find(What:="*", _ after:=rng.Cells(1), _ Lookat:=xlPart, _LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ searchdirection:=xlPrevious, _Matchcase:=False).Row
On Error GoTo 0
On Error Resume Next lcol = rng.Find(What:="*", _
after:=rng.Cells(1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ searchdirection:=xlPrevious, _ MatchCase:=False).Column
On Error GoTo 0
On Error Resume Next
RDB_Last = Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
RDB_Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
End Function
-----------------------------------------------------
Please give me your feedback.
if you want more information . comment me
thanks
Subscribe to:
Post Comments (Atom)
2 comments:
great work ? this code help me a lot to work? i thank him
thx man........
Post a Comment