View Single Post
 
Old 10-10-2015, 12:18 AM
Sandhya Sandhya is offline Windows 7 32bit Office 2007
Novice
 
Join Date: Nov 2014
Posts: 21
Sandhya is on a distinguished road
Arrow Consolidate data from different excel sheets

Hi Friends,

I have below mentioned code, it will open different excel files and paste into new excel, but the pasted location ie offset location of paste to file should start as required i.e. different files to different locations, can any one modify this code.

My Paste o sheet will Sheet1 location Start from G285 and so on...

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
Dim strWhereToCopy As String, strStartCellColName As String
Dim strListSheet As String

strListSheet = "List"

On Error GoTo ErrH
Sheets(strListSheet).Select
Range("B2").Select

'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
Set currentWB = ActiveWorkbook
Do While ActiveCell.Value <> ""

strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
strWhereToCopy = ActiveCell.Offset(0, 4).Value
strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)

Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook

Range(strCopyRange).Select
Selection.Copy

currentWB.Activate
Sheets(strWhereToCopy).Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select

Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False
dataWB.Close False
Sheets(strListSheet).Select
ActiveCell.Offset(1, 0).Select
Loop
Exit Sub

ErrH:
MsgBox "It seems some file was missing. The data copy operation is not complete."
Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
'Find the last used row in a Column: column A in this example
'http://www.rondebruin.nl/last.htm
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
Reply With Quote