Macro: copy data from .csv to another WorkBook using a button

[Lily83]

Hi;

Can anyone please help me!!!

I'm trying to do a Macro that is supose to open a file(the user has to choose the .csv) with a button and then copy the .csv data and paste in the another WorkBook(this workbook has the button to browse the "Open Dialog")

This is the code that I have

Private Sub cmdLoad_Click()
Call Load 'I call the macro
End Sub

Sub Load()

Dim fopen As Variant
fopen = Application.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") 'Here is where I browse the Open Dialog

If fopen <> False Then
Workbooks.OpenText Filename:=fopen, startrow:=1, DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierDoubleQuote, Tab:=False, Semicolon:=False, comma:=False, _
decimalSeparator:=".", thousandsSeparator:=","

' In this part is where I get lost, I don't know the code to copy the data of the .csv file or how paste it in the other workbook

End If

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fopen _
, Destination:=Range("A1"))
.Name = fopen
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.Refresh BackgroundQuery:=True
End With
End Sub

thanks for the help
Xoxo
Lily

 

[SkipVought]

Hi,

Why are you using the OPEN method on this TEXT file?

You already have a QueryTable to IMPORT the data.

You have the filename.

You already efresh the QueryTable, using the filename.

Copy the QueryTable range and paste it into another sheet

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fopen _
        , Destination:=Range("A1"))
        .Name = fopen
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .Refresh BackgroundQuery:=[b]False 'wait until refreshed
        .resultrange.copy
        Workbooks("other workbook name.xls").sheets(1).[A1].pastespecial xlvalues[/b]
    End With

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}

 

[Lily83]

Hi;

Thanks for your help, I'm using the Open because the user needs to choose a file which is generating everyday and its changing the name according to the day.

I use the code that you post and I get an error : "The destination range is not on the same worksheet that the Query table is being created on". I'm blank... :S.

This is the code

Private Sub CommandButton1_Click()
Call test
End Sub

Sub test()
Dim fopen As Variant
fopen = Application.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") 'Here is where I browse the Open Dialog

If fopen <> False Then
Workbooks.OpenText Filename:=fopen
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fopen _
, Destination:=Range("A1"))
.Name = fopen
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.Refresh BackgroundQuery:=False 'wait until refreshed
.ResultRange.Copy
Workbooks("QUALITY_RTDS.xls").Sheets(1).[A1].PasteSpecial xlValues ' this is the WorkBook where I need to paste the values from the .CSV File
End With

End Sub

XoXo
Thanks again

 

[SkipVought]

You do not need the other stuff. The QT has already been ADDED. This is just a refresh with NEW filename.

ALSO, the destination sheet must be cleared or any MERGE CELLS. I'd just do a

Workbooks("QUALITY_RTDS.xls").Sheets(1).cells.delete

Sub test()
    Dim fopen As Variant
    fopen = Application.GetOpenFilename("Comm Separated Value Files (*.csv), *.csv") 'Here is where I browse the Open Dialog
    
    With ActiveSheet.QueryTables(1)
        .Connection = "TEXT;" & fopen
        .Name = fopen
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .Refresh BackgroundQuery:=False 'wait until refreshed
        .ResultRange.Copy
        Workbooks("QUALITY_RTDS.xls").Sheets(1).[A1].PasteSpecial xlValues   ' this is the WorkBook where I need to paste the values from the .CSV File
    End With
End Sub

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}

 

[Lily83]

Hi!!!

It's me again, thanks for your help.... The Macro its working!!! But I have a doubt, when I open other file the content of the old file should be replace with the content of the new file,but when it does that, if the new content is shorter than the other, the last rows of the old file remain on the sheet. Anyway I make another button to clear the data, but I really wanted to know if there is another way to do it....
This is the final code

Private Sub cmdClear_Click()
Call Clear
End Sub
Sub Clear()
'
' Clear Macro

Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete
End Sub

Private Sub cmdLoadR_Click()
Call LoadRejects
End Sub
Sub LoadRejects()
' LoadRejects Macro

Dim file As Variant
file = Application.GetOpenFilename("CSV Files (*.csv), *.csv", Title:="Load Reject File")
If file <> False Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range("A4"))
.Name = file
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll down:=-18
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
End If
End Sub

and again Thanks 4 Ur HELP
XoXo
Lily

 

[SkipVought]

Check the Data > Data Range Properties to select the option you wish for if the number of rows in the data range changes...

The default replaces ALL the old data with new data.

FYI, there is also a checkbox at the bottom that you should check if you have formula(a) directly to the right of the data area.

Skip,

_{I'll be dressed to the nines this week, as I go to have my prostatectomy...
Because, if I'm gonna BE impotent, I want to LOOK impotent!}