PDA

View Full Version : Consolidate data from different excel files (VBA)



gvreddyhr
03-04-2013, 07:11 AM
Hi,

I have the excel file which consolidates the data from different workbooks and puts in desired workbook, now I need small customization to that where I need to incorporate sheet name for copying the data because I have multiple sheets available on the workbooks.
As I said, I need to specify the sheet from which the specified ranges will be copied. I tweaked the code accordingly and added the columns in List worksheet which is not working, running the macro then produces the error message. My code is as follows. My offsets are different because I have a total of 9 columns (I specified a specific range into which the data should be pasted. Headings are as follows:

Item No
File Name
Full Path
Data Range Start Cell
Data Range End Cell
Copy to Sheet
Copy To Location(Start Cell Only)
Copy To Location(End Cell Only)
Which Sheet Copy


Sub GetData()
Dim strWhereToCopy As String, strStartCellRange As String
Dim strListSheet As String, strWhichSheetCopy 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
strStartCellRange = ActiveCell.Offset(0, 5) & “:” & ActiveCell.Offset(0, 6)
strWhichSheetCopy = ActiveCell.Offset(0, 7).Value
Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook
Sheets(strWhichSheetCopy).Range(strCopyRange).Select
Selection.Copy
currentWB.Activate
Sheets(strWhereToCopy).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 one or more files were missing. The data copy operation is not complete.”
Exit Sub
End Sub


Thanks in advance

-GVR

SamT
03-05-2013, 09:28 AM
GV Reddy,

My VBA doesn't like "smart quotes" and "curly quotes." YMMV.

Converting all quotes to "Dumb quotes" gives this code. See if it fixes or changes your problem.

Also be sure to have "Option Explicit" at the top of all code pages. This will catch "smart quotes" for you

Option Explicit

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

snb
03-05-2013, 10:35 AM
I'd prefer:


Sub M_snb()
sn= thisworkbook.Sheets("List").cells(1).currentregion

for j=2 to ubound(sn)
with getobject(sn(j,3) & sn(j,2))
sp=.sheets(1).range(sn(j,4) & ":" & sn(j,5)).value
.close false
end with
thisworkbook.sheets(sn(j,6).range(sn(j,7)).resize(ubound(sp),ubound(sp,2))= sp
Next
End Sub

gvreddyhr
03-05-2013, 10:51 AM
Hi Sam,

I had updated the same code in excel which I have attached in my previous note it self,and it works, when your copy from workbook which have one sheet, If I have to specify the sheet name and other fields as I updated in previous note, I need help in tweaking the code.

Thanks in advance.

-GVR

SamT
03-05-2013, 11:08 AM
GV Reddy,

How is Sheet selected? By user or Automatic by criteria?

How are fields Selected? By Same?

I must go after this post. I will return Tomorrow? Tonight?

gvreddyhr
03-08-2013, 02:15 AM
Hi Sam,

Sorry for the delay in reply, I have the fields such as path, range, and all specified in sheet “List”, and the code works fine for that, now I want you to suggest me to tweak the code accordingly.

Refer the attachments which gives you more understanding.

Regards,
GV Reddy

SamT
03-08-2013, 02:56 PM
GV,

Take a look at this and see if it helps you. I tried to put in enough comments for complete understanding.

If I have misunderstood what you are asking, please let me know.

SamT
03-10-2013, 02:09 PM
GV,

I was going over the code I attached and noticed the improper use of the LastRow variable. You will need to add 1 to it before using it.

currentWB.Sheets(CopyToSht).Range(CopyToCol & CStr(lastRow + 1)).PasteSpecial _
xlPasteValues, _
xlPasteSpecialOperationNone
Alternately, you can change LastRow to NextRow and change the Function LastRowInOneColumn() to NextRowInOneColumn() and internally add 1 to it.

NextRowInOneColumn = WBToUse.Cells(.Rows.Count, ColumnToUse).End(xlUp).Row + 1

gvreddyhr
03-13-2013, 06:08 AM
Hi Sam,

Thank you so much for making your time and helping me.

I have tried with workbook which you ahve attached, its not working, can you relook in to the code.

am reattaching the workbook

Regards,
GVR

SamT
03-13-2013, 07:36 AM
GVR,

Your re-attachment didn't take.