Multiple files in different column order

PPDD129056 

Hi, the following vba macro read all csv and change the columns.

Function GetColumn(strTitle As String) As Integer
Dim rngFind As Range

Set rngFind = ActiveSheet.Rows(1).Find(what:=strTitle, lookat:=xlWhole)
If rngFind Is Nothing Then
GetColumn = 0
Else
GetColumn = rngFind.Column
End If

End Function


Sub Readall()
Dim strPfad As String
Dim strDatei As String
Dim Quelle As Workbook
Dim strName As String
Dim lngRowFree As Long
Dim lngRowMax As Long
Dim lngCol As Long

strPfad = ThisWorkbook.Path & "\"
strDatei = Dir(strPfad & "*.csv")

Application.DisplayAlerts = False

Do While strDatei <> ""
Workbooks.OpenText Filename:=strPfad & strDatei, Semicolon:=True, local:=True
Set Quelle = ActiveWorkbook

With Quelle.Worksheets(1)


lngRowMax = Quelle.Worksheets(1).UsedRange.Rows.Count
lngCol = GetColumn("name")
.Range(.Cells(1, lngCol), .Cells(lngRowMax, lngCol)).Copy Destination:=.Cells(1, 4)
lngCol = GetColumn("phone")
.Range(.Cells(1, lngCol), .Cells(lngRowMax, lngCol)).Copy Destination:=.Cells(1, 5)
lngCol = GetColumn("question")
.Range(.Cells(1, lngCol), .Cells(lngRowMax, lngCol)).Copy Destination:=.Cells(1, 6)

.Range("A:C").Delete

Quelle.SaveAs ThisWorkbook.Path & "\" & strDatei
Quelle.Close
End With

strDatei = Dir()

Loop
Application.DisplayAlerts = True
End Sub

regards

Bernd

http://www.vba-tanker.com