Hi All
I have a problem with my code. I need to call on a .csv file, format it, select a specific dynamic range and paste it in the sheet the macro was called from.
I managed most of the above, however, i can't get it back to the sheet the macro was called from.
I have tried multiple options, but it either gives me an error or break the code.
Above is the code I am currently using and my last attempt.
Any and all help will be appreciated.
Thank you.
I have a problem with my code. I need to call on a .csv file, format it, select a specific dynamic range and paste it in the sheet the macro was called from.
I managed most of the above, however, i can't get it back to the sheet the macro was called from.
I have tried multiple options, but it either gives me an error or break the code.
Code:
Sub GetCSVList()Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
.AllowMultiSelect = True
''Start in
.InitialFileName = "C:\Test"
.Show
End With
For Each fname In dlgOpen.SelectedItems
ImportCSV fname
Next
End Sub
Sub ImportCSV(fname)
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ws.Name = "test" & Worksheets.Count + 1
With ws.QueryTables.Add( _
Connection:="TEXT;" & fname, _
Destination:=Range("A1"))
.Name = "Test" & Worksheets.Count + 1
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:=False
'.UseListObject = False
End With
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(ws.Name)
Dim LastRow As Long
LastRow = ws1.Evaluate("=LOOKUP(2,1/(I:I>0), ROW(I:I))")
Dim CopyRange As Range
Set CopyRange = ws1.Range("A1", ws.Cells(LastRow, "I"))
CopyRange.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Replace What:="0", Replacement:="N/D", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Copy
Debug.Print CopyRange.Address
Call sourceSheet.Activate
End SubAbove is the code I am currently using and my last attempt.
Any and all help will be appreciated.
Thank you.
