Importer flere semikolon separeret fil fra mappe

Kære Hubertus

Jeg har benyttet en løsning à la denne - men det kræver, at du har alle dine file ri samme katalog, og at der ikke er "fremmede" filer i kataloget.

Dim FilTaeller as Integer

With Application.FileSearch

.NewSearch
.LookIn = "C:\temp"
'.SearchSubFolders = True
.SearchSubFolders = False
'.FileType = msoFileTypeExcelWorkbooks - denne kunne du bruge hvis det var Excel filer
.FileType = msoFileTypeAllFiles
.Execute

If .FoundFiles.Count > 0 Then
     
  For FilTaeller = 1 To .FoundFiles.Count
                 
  'Her gør du det der skal til - åbner og flytter og regerer
             
  Next FilTaeller
   
Else
               
  MsgBox ("Ingen data fundet")
 
End If

End With

Hej svnedj
Det ser fint ud, men jeg mangler lidt. Har du et bud på, hvordan den rutine skal se ud, flytter data ind  i regnearket. Informationerne i en record ser således ud:
"xxxx;yyyyy;Anders Brian Andersen;elev;3G".
xxxx skal placeres i en celle yyyy i en anden osv. " angiver at recorden er slut. Kan du også knække den, så er det super.
mvh. Hubertus

Test

Når filerne er semikolonseparerede burde nedenstående konstruktion virke. Det eneste, der mangler, er at lukke alle filerne løbende. .FoundFiles(FilTaeller) indeholder nemligt og stien, og så virker .close ikke - men hvis du trykke shift og så på Fil er Luk lavet om til Luk Alt og så lukker du alle åbne filer i ét hug. HUSK at gemme ændringer i din startfil. Hvis vi ikke er tæt nok på her, er du nødt til lige at smide en mailadr, så jeg kan se en ekempelfil.

Option Explicit
Sub HerErDen()

Dim FilTaeller As Integer
Dim StartFil As String

Application.ScreenUpdating = False 'Hvis du nu har mange filer, og ikke gider at se den blinke 100 gange

StartFil = ActiveWorkbook.Name

With Application.FileSearch

.NewSearch
.LookIn = "C:\temp"
'.SearchSubFolders = True
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute

If .FoundFiles.Count > 0 Then
   
  For FilTaeller = 1 To .FoundFiles.Count
 
    Workbooks.Open FileName:=.FoundFiles(FilTaeller)
    Cells.Copy
    Workbooks(StartFil).Activate
    Sheets.Add
    ActiveSheet.Paste
   
  Next FilTaeller
 
Else
             
  MsgBox ("Ingen data fundet")

End If

End With

Application.ScreenUpdating = True

End Sub

Hej Svendj
tilbage igen efter kundebesøg. Jeg har testet din kode, men som jeg ser det, så henter den xls filer og ikke csv filer. Formatet af csv filen er en række liner som har følgende format:  "xxxx;yyyyy;Anders Brian Andersen;elev;3G".
hver record skulle gerne placers, således at det som omsluttes af et semikolon placeres i hver sin celle.
mvh. Hubertus

Sorry du skal skifte .FileType = msoFileTypeExcelWorkbooks ud med .FileType = msoFileTypeAllFiles i koden. Det var en smutter - se evt. første version længere oppe.

Ang. indholdet i cellerne mener du så at

A1 xxxx
A2 yyyy
A3 Anders Brian Andersen

eller

A1 ;xxxx;
A2 ;yyyy;
A3 ;Anders Brian Andersen;

?

- og hvis det er det sidste - kan vi være sikre på, at der er data i alle celler i alle rækker?

:o]

Hej svendj
Det er korrekt at recorden skal splittes på den måde som du viser, blot skal vet være: A1 xxxx  B1 yyyy C1 Anders Brian Andersen - og uden semikolon. Næste record står så i række 2 osv.
:o))

Virker det så ikke nu?

Nej desværre. Der er 3 udfordringer. Den ene er, at filtypen specifik skal pege på csv filer, og den anden er at den indlæsning der sker nu, placer data i kolonne 1, således at hele den første række står i A1, næste i B1 osv. mao, der sker ikke en opsplitning af data, som skitseret i kommentaren 8:23. Den tredje udfordring er, at samtidig med, at der oprettes et nyt regneark med de indlæste data, så tilføjes en worksheet til det regneark, hvorfra makroen kaldes.
Kan du hjælpe med ovenstående?

lukker -