VBA Code To Copy data's for one worksheet to another worksheet ?

Question

Dear Every Body.

I have a folder named brand sales in which containing two more folders named temp & Brand Sales,in the temp folder is having 14 excel files with different name & folder name Brand sales is having an excel file containing 15 sheets including all 14 files which have been copied from folder name temp which became sheets in the the excel file name Brand sales.here in brand sales file is having one more sheet named brand sales in which data have been taken from all 14 sheets by formulas.Here I want to copy and past data from all 14 excel files to all 14 sheets in the brand sales file.
Is it possible if yes please provide me VBA code so that i can incorporate a macro in the file to automate the work.

Best Regards
sant

Answer 1

When the error occurs, check the values of the variables "IndDir" and "fn" to be sure that they are correct. Perhaps the error lies in the expression:

IndDir = Left(TotalDir, Len(TotalDir) - 12).





ADDITION:

What errors are you getting?

Make sure that

a) this macro is in the worksheet which has 15 tabs

and

b) this worksheet has sheet names of "0510", "0910", 1310", etc., based on your file names



I think this should work. Note the places where you should adjust the code for your individual situation.



Sub Copy14()



'fn = filename (adjust this list to match the 14 applicable filenames)

For Each fn In Array("Book1.xls", "Book2.xls", "Book3.xls", "Book4.xls", "Book5.xls", _

"Book6.xls", "Book7.xls", "Book8.xls", "Book9.xls", "Book10.xls", "Book11.xls", "Book12.xls", _

"Book13.xls", "Book14.xls")



'sheet name is same as filename without the .xls

sn = Left(fn, Len(fn) - 4)





'Get directory for total file

TotalDir = ThisWorkbook.Path



'Get directory for individual files

IndDir = Left(TotalDir, Len(TotalDir) - 12)





'Open each worksheet

Workbooks.Open Filename:=IndDir & "\" & fn



'Copy all of Sheet1 (obviously, this should be adjusted to the particular sheet and range)

Workbooks(fn).Sheets("Sheet1").Cells.Copy



'Paste into current workbook, applicable sheet (this only pastes values - change if necessary)

ThisWorkbook.Sheets(sn).Range("A1").PasteSpecial Paste:=xlPasteValues



'clear clipboard

Application.CutCopyMode = False



'close the worksheet

Workbooks(fn).Close



'go get the next worksheet

Next fn



End Sub

Answer 2

Hello -- You could try object Linking ... (1) Select the data you want to copy (2) Copy the selection (3) Goto to the document you want to receive the data (4) In the Edit Menu select "Paste Special ..." select from the menu the appropriate items and then select paste link. Note that this linking will allow you to update the original and all the links automatically ... if you are using the same data in many document (even MS Word and MS Access) this saves a lot of time and work. Good Luck Bill

Answer 3

Dear Experts,



i have modified the VBA code given by you which is being written below ,but its not working.



Sub Copy14()



'fn = filename (adjust this list to match the 14 applicable filenames)

For Each fn In Array("0510.xls", "0910.xls", "1310.xls", "1810.xls", "2210.xls", _

"2610.xls", "3110.xls", "3510.xls", "3910.xls", "4410.xls", "4810.xls", "5310.xls")



'sheet name is same as filename without the .xls

sn = Left(fn, Len(fn) - 4)





'Get directory for total file

TotalDir = ThisWorkbook.Path



'Get directory for individual files

IndDir = Left(TotalDir, Len(TotalDir) - 12)





'Open each worksheet

Workbooks.Open Filename:=IndDir & "\" & fn



'Copy all of 0510(0510, A1:AV7000)

Workbooks(fn).Sheets("0510").Cells.Cop…



'Paste into current workbook, applicable sheet (this only pastes values - change if necessary)

ThisWorkbook.Sheets(sn).Range("A1").Past… Paste:=xlPasteValues



'clear clipboard

Application.CutCopyMode = False



'close the worksheet

Workbooks(fn).Close



'go get the next worksheet

Next fn



End Sub