¿Como importar csv y exporto a excel?

Ayuda tengo una macro que me importa csv a excel, al volver a importa se inserta en la siguiente columna y no debajo. Como puedo hacer para que se importe sobre la base actual y luego guardar en otro excel como base. Les dejo la macro que uso, agradezco el apoyo

Sub ImportarCSV()

Dim t As Single
t = Timer
'Sheets("DATOS").Cells.ClearContents
strFile = Application.GetOpenFilename("CSV, *.csv")
If strFile = Empty Then
Response = MsgBox("Ningún fichero seleccionado", vbOKOnly, "Error")
Exit Sub
Else
End If
'Range("A4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Sheets("DATOS").QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=Sheets("DATOS").Range("$A$4"))
.Name = "fichero"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True 'CSV: punto y coma
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 9, 1, 1, 1) '5 columnas
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
MsgBox Timer - t
End Sub

Con este codigo enlazo el archivo que deseo importar:

Sub AnexarCSV()
Dim t As Single
t = Timer
Sheets("DATOS").Select
Dim LastRow As Long
LastRow = Range("$A$1").End(xlDown).Rows + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;\\domibco.com.pe\DFS\ICRedes\Enlaces\base\fichero.csv", Destination:=Range("$A$1"))
.Name = "fichero"
.FieldNames = True
.Numbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows ' Inserta filas
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 2 ' Salta 1ª línea con encabezado
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True 'CSV: punto y coma
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 9, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
MsgBox Timer - t
End Sub

1 Respuesta

Respuesta
1

Prueba cambiando esta línea:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;\\domibco.com.pe\DFS\ICRedes\Enlaces\base\fichero.csv", Destination:=LastRow)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas