copy Cells From a Workbook And Paste them to another workbook

[mcelik]

Hi eveyone,

i would appreciate if anybody could help me.

I have a lot of excel workbooks in a folder. They all have same table with different values. values are between B4 and J33 cells. each column has different currency values. I want to consolidate this values in a master file. The table format can be seen below.

The target file(master file) format is like this,

First of all i want to copy the name of the source file to cell A3 in master file
then i want to copy dollar values(B4-B33 Cells) from source file and paste it to master file(B3-AE3 Cells).
Then i want to copy Euro values(C4-C33 Cells) from source file and paste it to master file(AF3-BI3 Cells).
And i want to do it for the other currencies to.



I basicly would like to do the same thing as this code does but i want to copy specific cells and paste it to another specific cells.

'=========================================================
'- CONSOLIDATE DATA SHEETS
'- (ALL WORKBOOKS IN FOLDER.ALL SHEETS)
'=========================================================
'- Generic code for transferring data from
'- all worksheets from all workbooks contained in a folder
'- to a single sheet.
'- Change "Sub Transfer_data()" etc. as required.
'----------------------------------------------------------
'- Workbooks must be the only ones in the folder.
'----------------------------------------------------------
'- worksheets must be contain tables which are
'- identical to the master, headings in row 1.
'- *master sheet is remade each time*
'- run this code from the master sheet (with headings)
'- by Brian Baulsom (BrianB) January 1st.2004
'----------------------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'=========================================================
'- MAIN ROUTINE
'=========================================================
Sub FILES_FROM_FOLDER()
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
'---------------------------
'- MASTER SHEET
'---------------------------
Set ToSheet = ActiveSheet
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(ToSheet.Cells(2, 1), _
ToSheet.Cells(ToRow, NumColumns)).ClearContents
End If
ToRow = 2
'------------------------------------------
'- main loop to open each file in folder
'------------------------------------------
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data ' subroutine below
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'
'==============================================================
'- CHANGE THIS CODE TO DO WHAT YOU WANT TO THE OPENED WORKBOOK
'- HERE IT COPIES DATA FROM ALL SHEETS TO THE MASTER SHEET
'==============================================================
Private Sub Transfer_data()
Workbooks.Open FileName:=FromBook
For Each FromSheet In Workbooks(FromBook).Worksheets
LastRow = FromSheet.Range("A65536").End(xlUp).Row
'-----------------------------------------------------
'- copy/paste to master sheet
FromSheet.Range(FromSheet.Cells(2, 1), _
FromSheet.Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
'-----------------------------------------------------
'- set next ToRow
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Next
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ====================================================


Is my explanation clear enough?


Any help would be highly appreciated.

Thanks in advance!