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

V

vicky

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 .
 
J

joel

Try the code below. Change the FOLDER name as required. Make sure yo
have a backslash at the end of the folder name. The Macro will give yo
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 Su
 
J

joel

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
 
V

vicky

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 before:=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.Count)
ActiveSheet.Name = obj.Range("A1")
wb.Close
TheFile = Dir
Application.CutCopyMode = False

Loop
 
Top