Is there a way to import data from .csv to active excel sheet?
Add this code to create a QueryTable in the PO Data sheet to your data source
Once you have created the QueryTable you can then just right click Refresh the data (or refresh on open)
Sub CSV_Import()
Dim ws As Worksheet, strFile As String
Set ws = ActiveWorkbook.Sheets("PO Data") 'set to current worksheet name
strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End Sub
There are lots of ways to get data into Excel. Querytables (as demonstrated by The_Barman), SQL, Import Wizard etc.
Usually the method depends on how clean the data is presented on the files you need to import and if you know exactly how it's laid out. Eg if there are empty rows, mixed data types, merged cells etc then it can be a nightmare.
Below is a slower 'brute-force' method which will usually get all data by opening the file in Excel first. It's often the last thing to do when other methods fail.
Option Explicit
Public Sub ImportData()
Dim CSVFilename As String
Dim writeToFilename As String
Dim writeToSheet As String
Dim readXL As Workbook
Dim readWS As Worksheet
Dim writeXL As Workbook
Dim writeWS As Worksheet
Dim UsedRng As Range
CSVFilename = Environ$("USERPROFILE") & "\Desktop" & "\SO2PO.csv"
writeToFilename = Environ$("USERPROFILE") & "\Desktop" & "\Open Order.xlsx"
writeToSheet = "PO Data"
Set writeXL = GetObject(writeToFilename)
Set writeWS = writeXL.Sheets(writeToSheet)
'writeWS.Parent.Windows(1).Visible = True
Set readXL = GetObject(CSVFilename)
With readXL
Set readWS = readXL.Sheets(1)
Set UsedRng = RealUsedRange(readWS)
writeWS.Range(UsedRng.Address).Value = UsedRng.Value
End With
'close CSV without saving
readXL.Close SaveChanges:=False
Set readWS = Nothing
Set readXL = Nothing
'close template with save
writeXL.Close SaveChanges:=True
Set writeWS = Nothing
Set writeXL = Nothing
End Sub
Public Function RealUsedRange(ByVal WS As Worksheet) As Range
'Find used range
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstColumn As Integer
Dim LastColumn As Integer
On Error Resume Next
With WS
FirstRow = .Cells.Find(What:="*", After:=.Cells(.Rows.Count, .Columns.Count), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
FirstColumn = .Cells.Find(What:="*", After:=.Cells(.Rows.Count, .Columns.Count), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set RealUsedRange = .Range(.Cells(FirstRow, FirstColumn), .Cells(LastRow, LastColumn))
End With
On Error GoTo 0
End Function
If you're going to use querytables make sure you clean up after, leftover query tables caused me a few headaches in a downstream process.
' get the file to the data sheet
Set ws = ActiveWorkbook.Sheets("Data")
With ws.QueryTables.Add(Connection:="TEXT;" & "mydata.csv", Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
' delete the querytable if there is one
On Error GoTo nothingtodelete
Sheets("Data").QueryTables(1).SaveData = False
Sheets("Data").QueryTables.Item(1).Delete
nothingtodelete: