copy and paste it in a new sheet with sheet name as a1 value
 

I have many work books in one folder . want to copy data from every
workbook to
the resultworkbook and the sheet names should be of a1 value .

copy and paste it in a new sheet with sheet name as a1 value
 

Try the code below. Change the FOLDER name as required. Make sure you
have a backslash at the end of the folder name. The Macro will give you
an error if the data in cell A1 is not a valid name for a worksheet.
worksheet names can't be nothing and can't contain certain characters.


Sub copybooks()

Folder = "C:\temp\"
FName = Dir(Folder & "*.xls")
Do While FName < ""
'open workbook
Set bk = Workbooks.Open(Folder & FName)
For Each sht In bk.Worksheets
With ThisWorkbook
sht.Copy after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = sht.Range("A1")
End With
Next sht

bl.Close savechanges:=False
FName = Dir()
Loop

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152271

Microsoft Office Help

copy and paste it in a new sheet with sheet name as a1 value
 

thanks a lot joel...

copy and paste it in a new sheet with sheet name as a1 value
 

I have a small typo

from
bl.Close savechanges:=False
to
bk.Close savechanges:=False

I didn't test this line. the rest of the code was tested.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152271

Microsoft Office Help

copy and paste it in a new sheet with sheet name as a1 value
 

i have tried this code as wel . its working .... thamks joel for
taking time to answer my questions....

Set NewWkb = ThisWorkbook
MyPath = "C:\Documents and Settings\vb\"
ChDir MyPath
TheFile = Dir("*.xls")
Do While TheFile < ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
Set obj = wb.Sheets(1)
obj.Cells.Copy
NewWkb.Sheets.Add befo=NewWkb.Sheets(NewWkb.Sheets.Count)
sht.Copy after:=.Sheets(.Sheets.Count)
With NewWkb.ActiveSheet
..Range("a1").PasteSpecial xlPasteValues
..Name = obj.Range("a1").Value
End With
obj.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ActiveSheet.Name = obj.Range("A1")
wb.Close
TheFile = Dir
Application.CutCopyMode = False

Loop