Jag har satt ihop ifrån lite olika sites en funktion för att flytta cvs-fil information in i en excell-fil. Det fungerade kanon i fredags men nu så vägrar det att fungera och jag har inte gjort någon förändring i koden. Är där något annat som kan ha hänt vet inte vad jag skall leta?
Denna biten är inte min kod utan hämtad ifrån ett forum och har fungerat bra under hela fredagen när jag arbetade med den.

'Start subben för att göra alla funktioner
Sub ImportAllCSV()
  Dim FName As Variant, R As Long
  R = 1
  FName = Dir("*.csv")
  Do While FName <> ""
    ImportCsvFile FName, ActiveSheet.Cells(R, 1)
    R = ActiveSheet.UsedRange.Rows.Count + 1
    FName = Dir
  Loop
End Sub

' Sub för att inportera csv fil info till blad med namn från filnamnet
Sub ImportCsvFile(FileName As Variant, Position As Range)
Dim newString As String
Dim char As Variant
      ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FileName _
        , Destination:=Range("$A$1"))
        .Name = "A00-40---1-D02------ Klar_allt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ' det som är in kopierat några kolumner tas bort
    Columns("C:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    newString = Right(FileName, 25)
    'fixar till bladnamnet
    For Each char In Split(SpecialCharacters, ",")
        newString = Replace(newString, char, "")
    Next
    ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Det spontana jag ser är att dir-kommandot listar per default det som finns i aktuell katalog. Kan filerna ligga i en annan mapp? I övrigt, får du felmeddelande eller vad händer eller inte händer?

Hälsningar Pelle

Filerna ligger i samma katalog. Det jag upptäkte vara att om jag öppnade filen ifrån excel istället för att dubbel klicka i utforskaren fungerade allt, så jag ändrade koden till:

'Start subben för att göra alla funktioner
Sub ImportAllCSV()
  Dim FName As Variant, R As Long
    Application.ScreenUpdating = False
        R = 1
        Set CurrWB = Workbooks("Bok1.xlsm")
        directory = CurrWB.Path
        FName = Dir(directory & "\" & "*.csv")
            Do While FName <> ""
              ImportCsvFile FName, ActiveSheet.Cells(R, 1)
              R = ActiveSheet.UsedRange.Rows.Count + 1
              FName = Dir
            Loop
            
                Call KopieraUnikaRaderBlad
                Call RaderaLine
                Call SammanStall
                Call SidforNummer
                Call KollaFlyttaData
               'Call RäknaData
    Application.ScreenUpdating = True
End Sub

' Sub för att inportera csv fil info till blad med namn från filnamnet
Sub ImportCsvFile(FileName As Variant, Position As Range)
Dim newString As String
Dim char As Variant
      ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FileName _
        , Destination:=Range("$A$1"))
        .Name = "A00-40---1-D02------ Klar_allt" 'vet inte vad den här linjen gör verkar som inget
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ' det som är in kopierat några kolumner tas bort
    Columns("C:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    newString = Right(FileName, 25)
    'fixar till bladnamnet
    For Each char In Split(SpecialCharacters, ",")
        newString = Replace(newString, char, "")
    Next
    ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Men med denna kod så stannar vid

.Refresh BackgroundQuery:=False

och jag får felmeddelandet "Kör fel nr 1004: det går inte att hitta textfilen för att uppdatera detta externa datområde. Kontrollera att filen inte flyttats eller bytt namn och försök att uppdatera på nytt".
Så det jag tror är att excel inte rätt koppling till filen/mappen som filerna finns i när man öppnar ifrån utforskaren, men får rätt koppling när man öppnar innen ifrån excel. Frågan är hur man fixar det?

Det finns ett kommando som jag tror heter curdir som kan användas för att peka ut den katalog som Excel startas från. Det kan var så att currwb.path skiljer sig från den katalog du står i.

Testa sånt genom att kasta in magbox för att se vad du har för värden när loopen körs, ex:

  directory = CurrWB.Path
        FName = Dir(directory & "\" & "*.csv")
        magbox(fname)

/Pelle

Denna delen verkar fungera bra nu

'Start subben för att göra alla funktioner
Sub ImportAllCSV()
  Dim FName As Variant, R As Long
    Application.ScreenUpdating = False
        R = 1
        Set CurrWB = Workbooks("Bok1.xlsm")
        directory = CurrWB.Path
        FName = Dir(directory & "\" & "*.csv")
        MsgBox directory & " och " & FName
            Do While FName <> ""
              ImportCsvFile FName, ActiveSheet.Cells(R, 1)
              R = ActiveSheet.UsedRange.Rows.Count + 1
              FName = Dir
            Loop
            
                Call KopieraUnikaRaderBlad
                Call RaderaLine
                Call SammanStall
                Call SidforNummer
                Call KollaFlyttaData
               'Call RäknaData
    Application.ScreenUpdating = True
End Sub

Det är den andra delen som jag nu inte får till att fungera. Som jag skrev i tidigare.

vad händer om du tar bort kommandot refresh?

Ta bort Refresh gör ingen skillnad.
Men jag har hittat svaret.
Den första Sub’n är lösningen att sätta path till Dir funktionen

        Set CurrWB = Workbooks("Bok1.xlsm")
        directory = CurrWB.Path & "\"
        FName = Dir(directory & "*.csv")
            Do While FName <> ""

Den andra Sub’n så hittade jag en referens till hur man bygger en Connection och där var med file path.

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & directory & FileName _
        , Destination:=Range("$A$1"))

Här är den färdiga programeringen

'Start subben för att göra alla funktioner
Sub ImportAllCSV()
  Dim FName As Variant, R As Long
    Application.ScreenUpdating = False
        R = 1
        Set CurrWB = Workbooks("Bok1.xlsm")
        directory = CurrWB.Path & "\"
        FName = Dir(directory & "*.csv")
            Do While FName <> ""
              ImportCsvFile FName, ActiveSheet.Cells(R, 1), directory
              R = ActiveSheet.UsedRange.Rows.Count + 1
              FName = Dir
            Loop
            
                Call KopieraUnikaRaderBlad
                Call RaderaLine
                Call SammanStall
                Call SidforNummer
                Call KollaFlyttaData
               'Call RäknaData
    Application.ScreenUpdating = True
End Sub

' Sub för att inportera csv fil info till blad med namn från filnamnet
Sub ImportCsvFile(FileName As Variant, Position As Range, directory As Variant)
Dim newString As String
Dim char As Variant
      ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & directory & FileName _
        , Destination:=Range("$A$1"))
        .Name = "A00-40---1-D02------ Klar_allt" 'vet inte vad den här linjen gör verkar som inget
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .WorkbookConnection.Delete
    End With
    ' det som är in kopierat några kolumner tas bort
    Columns("C:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    newString = Right(FileName, 25)
    'fixar till bladnamnet
    For Each char In Split(SpecialCharacters, ",")
        newString = Replace(newString, char, "")
    Next
    ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Snyggt jobbat!