Hi all,
I have to import data from 3 different files into 1 and format the
data. Since everything is more or less fixed, I have recorded the
macro below and removed the code for scrolling and such. The only
problem for me is that each month the locations and filenames of the
files to import are changing. What woudl the code be so the excel
prompts me for each file?
Thank you in advance for your help.
Code:
---------------------------------------------------------------------
Sub uvoz_podatkov()
'
' uvoz_podatkov Makro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Path to my file1.csv", Destination:= _
Range("$A$1"))
.Name = "MyFile1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("List2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Path to my file2.csv", Destination:= _
Range("$A$1"))
.Name = "MyFile2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("List3").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;Path to my file3.csv", Destination:= _
Range("$A$1"))
.Name = "MyFile3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A:I,K:L").Select
Range("K1").Activate
Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z").Select
Range("Y1").Activate
Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z,AB:AC,AE:AF,AH:AI").Select
Range("AH1").Activate
Range("A:I,K:L,O:O,R:R,T:T,V:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AN").Select
Range("AK1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.AutoFilter
Range("D:D,A:A").Select
Range("A1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Sheets("List2").Select
Columns("A:I").Select
Range("A:I,N:N,R:R,T:U").Select
Range("T1").Activate
Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD").Select
Range("AC1").Activate
Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ").Select
Range("AI1").Activate
Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ,AL:AM,AO:AP,AR:AS").Select
Range("AR1").Activate
ActiveWindow.ScrollColumn = 36
Range("A:I,N:N,R:R,T:U,W:X,Z:AA,AC:AD,AF:AG,AI:AJ,AL:AM,AO:AP,AR:AS,AT:AU").
_
Select
Range("AT1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.AutoFilter
Range("E:E,A:A").Select
Range("A1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Sheets("List1").Select
Range("A:B,C:C,D:I,K:K,N:N").Select
Range("N1").Activate
Range("A:B,C:C,D:I,K:K,N:N,Q:T").Select
Range("Q1").Activate
Range("A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF").Select
Range("AE1").Activate
Range("A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AL,AN:AO,AQ:AR").
_
Select
Range("AQ1").Activate
Range( _
"A:B,C:C,D:I,K:K,N:N,Q:T,W:W,Y:Z,AB:AC,AE:AF,AH:AI,AK:AL,AN:AO,AQ:AR,AT:AX").
_
Select
Range("AT1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.AutoFilter
Range("D:D,A:A").Select
Range("A1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
End Sub
-------------------------------------------------------------------------------------
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
