Automate Data Import in Excel

[njls]

Hello,
Hope somebody can help me. I am trying to make this process automate but have only limited knowledge about vba and want to know if this is possible.

I receive about 4 excel files everyday in a folder C:\Data\ and each file saved by name ( Like Data201212101, Data201212102,Data201212103,). each file have 7 columns A to H and contain 100 rows. From Data201212101 file, i only need to exctract specific data to MasterData file located in C:\MasterData\, which i later upload in to Access database. The cells i need from Data20121210 file are going to be same cell i need each time when run this process.

I want to automate the way that when i press vba button it will automaticly extract specific data from each files(dosent duplicate) and save to this Masterdata file(overwriting the old data).

Any help would be highly appreciated!
i try to upload 2 sample files but it only allowed me one.

[GreenDR]

do you mean to consolidate data from all files , remove duplicates, and paste the result in access database table?

[njls]

I meant Conslidate all files data in one master file and then i will manually upload it in to access database.

When i said remove duplicated i meant once data is extracted from one file, that file should be desabled or send to other folder so it it wont copy over data twice.

[njls]

Attach is MasterData file which the data need and like to extract to.

[GreenDR]

the below code will iterate thru each file in the folder
i didn't get what you actually want, since the fields in the data file and master file do not match
try inserting the code within the below code.


Sub Consolidation()
Dim fs, f, fc, fx
Dim pth As String

pth = "C:\Data\"

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pth)
Set fc = f.Files
Application.ScreenUpdating = False
For Each fx In fc
Workbooks.Open fx
'code for copying goes here
Workbooks(fx.Name).Close False
Next
Application.ScreenUpdating = True
MsgBox "Done!"

End Sub

[GreenDR]

the below code will iterate thru each file in the folder
i didn't get what you actually want, since the fields in the data file and master file do not match
try inserting the code within the below code.


Sub Consolidation()
Dim fs, f, fc, fx
Dim pth As String

pth = "C:\Data\"

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pth)
Set fc = f.Files
Application.ScreenUpdating = False
For Each fx In fc
Workbooks.Open fx
'code for copying goes here
Workbooks(fx.Name).Close False
Next
Application.ScreenUpdating = True
MsgBox "Done!"

End Sub

[njls]

:thumb Thank You So much GreenDR!
sorry for the confusion But have difficulty on figuring out where should i put copying from and pasting to code.

Here is details about What I am exactly trying to do:
I have Folder in C:\Data\ where i put couple excel files( like Data121454,Data245454,Data547484) everyday. From that Folder (from each file) i want to copy Specific data (Like B3,B6,B7,B11) to another excel master file in row A1,B1,C1,D1. (so it will be like B3 to A1, B6 to B1, B7 to C1, B11 to D1) and next file will be (like B3 to A2, B6 to B2, B7 to C2, B11 to D2).

sorry, I am trying to be clear as possible.

[GreenDR]

you can modify the below code according to your requirement.

Sub copy_data_to_master_file()
Dim fs, f, fc, fx
Dim pth As String, master_file As String
pth = "C:\Data\"
master_file = "C:\MasterData\MasterData.xls"
Workbooks.Open master_file
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pth)
Set fc = f.Files
Application.ScreenUpdating = False
For Each fx In fc
Workbooks.Open fx
Range("B1").Select


'copy segment brgins
Range(Selection, Selection.End(xlDown)).Select
If Range("C1") <> "" Then
Range(Selection, Selection.End(xlToRight)).Select
End If
Selection.Copy
'copy segment ends


Windows("MasterData.xls").Activate
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select

'paste segment begins
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'paste segment ends

ActiveCell.Offset(0, 2).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(-1, 0).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
If ActiveCell.Offset(1, 0).Value <> "" Then
Range(Selection, Selection.End(xlDown)).Select
End If
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(fx.Name).Close False
Next
Windows("MasterData.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUp1dating = True
MsgBox "Done!"
End Sub

[njls]

Thank you so Much, This is what i was looking for.

Now i am Getting Run Time error '1004'

I check the code it looks fine.

[GreenDR]

can you share your code / file, so that i can check it and get back to you?

[GreenDR]

thanks for sharing the code,
firstly make sure that the file extension is .xlsx or .xls and change the same accordingly in the code

master_file = "H:\MasterData\MasterData.xlsx"

and

Windows("MasterData.xls").Activate


(the above codes have different file extensions in them, please change them according to the extension you use in your system)

secondly, the cells you have selected in the below code aren't getting copied, you need to copy and paste each cell one at a time.


Range("D1").Select
Range("E2").Select
Range("E3").Select
Range("B4").Select
Range("D5").Select
Range("D6").Select

[njls]

so i have modiied the code based on my understanding of vba but it only copies data from one file. Can you please help me with this?



Sub copy_data_to_master_file()
Dim fs, f, fc, fx
Dim pth As String, master_file As String
pth = "H:\Data\"
master_file = "H:\MasterData\MasterData.xlsx"
Workbooks.Open master_file
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pth)
Set fc = f.Files
Application.ScreenUpdating = False
For Each fx In fc
Workbooks.Open fx
Worksheets("Sheet1").Range("D1").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveSheet.Paste

'paste segment ends
Workbooks.Open fx
Worksheets("Sheet1").Range("E2").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste


Workbooks.Open fx
Worksheets("Sheet1").Range("E3").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste


Workbooks.Open fx
Worksheets("Sheet1").Range("B4").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveCell.Offset(0, 3).Range("A1").Select
ActiveSheet.Paste

Workbooks.Open fx
Worksheets("Sheet1").Range("D5").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveSheet.Paste

Workbooks.Open fx
Worksheets("Sheet1").Range("D6").Select
Selection.Copy
Windows("MasterData.xlsx").Activate
Worksheets("Sheet1").Range("A1").Select
ActiveCell.Offset(0, 5).Range("A1").Select
ActiveSheet.Paste
Workbooks.Open fx
Workbooks(fx.Name).Close False

Next

ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

[GreenDR]

The below code does the job


Sub copy_data_to_master_file()
Dim fs, f, fc, fx
Dim master As String
Workbooks.Open "C:\MasterData\MasterData.xls"
master = ActiveWorkbook.Name
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Data\")
Set fc = f.Files
Application.ScreenUpdating = False
For Each fx In fc
Workbooks.Open fx

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("D1").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("E2").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(0, 1).Select
ActiveSheet.Paste

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("E3").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(0, 2).Select
ActiveSheet.Paste

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("B4").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(0, 3).Select
ActiveSheet.Paste

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("D5").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(0, 4).Select
ActiveSheet.Paste

Workbooks(fx.Name).Activate
Sheets("Sheet1").Range("D6").Copy
Workbooks(master).Activate
Sheets("Sheet1").Range("A1").End(xlDown).Offset(0, 5).Select
ActiveSheet.Paste

Application.CutCopyMode = False

Workbooks(fx.Name).Close False

Next

Workbooks(master).Save
Workbooks(master).Close
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub