• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Extraction of Data from Closed workbooks using vba

R

raypk

Member
I have a database in one folder. Plz Unzip and see all excel files shown datewise. Can anyone help me in extracting day wise data of parameters in format shown in Monthly tracker sheet.
Please check the format. It should be like if i select one workbook data from only that one will be extracted, if selected 2 data from one and two both so on and so forth till 31 days. i am uploading the the database and monthly tracker.


please help .... I am in urgent need...
thanks in advance
 

Attachments

  • DB.zip
    38.8 KB · Views: 11
Hi
I can help you with the codes, do you know VBA to customize, sry dont have mch time due to work schedule to do it.
 
The code below would bring a file browser window where you can select your file that has the source data (ReportWbk), and then data is copied from SHEET1 and SHEET2 and pasted in the current file. the ranges are also specified. pls amend codes accordingly for your use. Thx

Code: 
Sub AutoCopy()
'Copy data automatically

On Error GoTo here


Dim ReportWbk As Workbook 'workbook with report data
Dim Report As String 'name of file with report data

Application.FileDialog(msoFileDialogFilePicker).Show
Report = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
Set ReportWbk = Workbooks.Open(Report)
Application.DisplayAlerts = False
'Application.ScreenUpdating = False


ReportWbk.Sheets("SHEET1").Activate
ReportWbk.Sheets("SHEET1").Range("a7:ar7", Range("a7:ar7").End(xlDown)).Copy
ThisWorkbook.Sheets("SHEET1").Activate
Cells(7, 1).Select: Selection.PasteSpecial xlPasteValues
Cells(7, 1).Select

ReportWbk.Sheets("SHEET2").Activate
ReportWbk.Sheets("SHEET2").Range("a7:au7", Range("a7:au7").End(xlDown)).Copy
ThisWorkbook.Sheets("SHEET2").Activate
Cells(7, 1).Select: Selection.PasteSpecial xlPasteValues
Cells(7, 1).Select

ReportWbk.Close (False)

Application.DisplayAlerts = True
'Application.ScreenUpdating = True


here:
'MsgBox ("Select the correct file!")
Exit Sub

End Sub
 
I haven't tested!


Code: 
Sub test()
Dim ows As Worksheet, strfile As String, owbk As Workbook
Dim sPath As String, mysheet As String, myday As Integer, fcell As Range
Dim crng As Range


sPath = Application.ThisWorkbook.Path & "\"
strfile = Dir(sPath & "*.xlsx")
If strfile = "" Then MsgBox "No Files found!!!", vbCritical: Exit Sub

Do While strfile <> ""
myday = Split(strfile, "-")(0)
Set owbk = Workbooks.Open(sPath & strfile)
Set crng = owbk.Sheets(1).[A1].CurrentRegion

    For Each ws In ThisWorkbook.Sheets
        Set fcell = crng.Find(ws.Name)
        If Not fcell Is Nothing Then
            With crng
              .Resize(.Rows.Count - 1, 1).Offset(1, fcell.Column).Copy
            End With
            With ws
                .Cells(.[A1].CurrentRegion.Rows.Count + 1, myday + 1).PasteSpecial -4104
            End With
        End If
    Next
    owbk.Close False
   
strfile = Dir
Loop
     
End Sub
 
hi Deepak, can u please do extraction for the first sheet in Monthly tracker excel file ...from the databases files and suggest me the way for other sheets in that monthly tracker please ...i am quite new to vba, excited to learn ...it will definitelyserve as a motivation for me
 
Oh.I will do. First do the subjected query.

Place all files including master in same folder.

Insert a module in master workbook & copy the code to there.

Also change the below line

Code: 
With ws
                .Cells(.[A1].CurrentRegion.Rows.Count + 1, myday + 1).PasteSpecial -4104
  End With

To
Code: 
 ws.cells(2, myday + 1).PasteSpecial -4104
 
Hi Deepak ! its just extracting the data from the column no. one more than what i need..
e.g. like i need data from Column O from each workbook, it is extracting data from Column P ...please help
 
raypk said:
Hi Deepak ! its just extracting the data from the column no. one more than what i need..
e.g. like i need data from Column O from each workbook, it is extracting data from Column P ...please help
Click to expand...
Change it

fcell.Column

To

fcell.Column-1
 
@raypk Your discussion:
'Extraction of Data from Closed workbooks using vba' ...
Did You mean that 'Do not open workbooks and get data from those?'
If so, that's possible too ... but with 'open', it would be easier.
 
hi deepak ...

if the same thing can be used with "Vlookup " function please tell how to change for every parameters..please provide the code fors extraction for different sheets
 
@Deepak ninja please help me out with the same output using vlookup thing...please i was helpless..using vlookup corresponding to cells in column will definitely yeild correct result...plz...please provide code for vlookup in 'for'loop ...many many thnx
 
@ raypk

Check this..

Code: 
Sub test1()
Dim strfile As String, owbk As Workbook, c_col As Integer, myrng As Range
Dim sPath As String, myday As Integer, fcell As Range, crng As Range


sPath = Application.ThisWorkbook.Path & "\"
strfile = Dir(sPath & "*.xlsx")
If strfile = "" Then MsgBox "No Files found!!!", vbCritical: Exit Sub

Do While strfile <> ""
myday = Split(strfile, "-")(0)
Set owbk = Workbooks.Open(sPath & strfile)
Set crng = owbk.Sheets(1).[A1].CurrentRegion

    For Each ws In ThisWorkbook.Sheets
        With ws
            Set fcell = crng.Find(.Name)
            If Not fcell Is Nothing Then
                c_col = .[A1].CurrentRegion.Rows.Count
                Set myrng = .Range(ws.Cells(2, myday + 1), .Cells(c_col, myday + 1))
                myrng = "=VLookup(a2," & crng.Offset(, 2).Address(, , , True) & "," & fcell.Column - 2 & ",0)"
                myrng.Value = myrng.Value
            End If
            Set myrng = Nothing
        End With
    Next
    owbk.Close False
 
strfile = Dir
Loop
End Sub
 
You must log in or register to reply here.
Back
Top