title image


Smiley Re: mehrere Excel Dateien in eine Adressdatei zusammenfügen
hi



ich hoffe du kannst das anpassen







      

Public Function GetXLFiles(ByRef astrXLFiles() As String, _

      ByVal strLookIn As String, Optional fSearchSubfolders _

      As Boolean = False) As Boolean



  Dim nFilesCnt   As Long

  Dim nFile       As Long

  Dim nCounter    As Long

  Dim strFileName As String



  On Error Resume Next

  With Application.FileSearch

    .NewSearch

    .LookIn = strLookIn

    .SearchSubFolders = fSearchSubfolders

    .Filename = ".xls"

    .FileType = msoFileTypeExcelWorkbooks



    If .Execute(SortBy:=msoSortByFileName, SortOrder:= _

          msoSortOrderAscending, AlwaysAccurate:=True) > 0 Then



      nFilesCnt = .FoundFiles.Count

      ReDim astrXLFiles(0 To nFilesCnt - 1)



      nCounter = -1

      For nFile = 1 To nFilesCnt

        strFileName = .FoundFiles(nFile)

        If Len(Dir$(strFileName)) > 0 Then

          nCounter = nCounter + 1

          astrXLFiles(nCounter) = strFileName

        End If

      Next



      If nCounter > -1 Then

        ReDim Preserve astrXLFiles(0 To nCounter)

        GetXLFiles = True

      End If

    End If

  End With

  On Error GoTo 0

End Function

   

 

 

  Public Sub einlesen()

  Dim strPath       As String

  Dim astrXLFiles() As String

  Dim nFile         As Long



  strPath = "C:\xx\" 'ANPASSEN 'hier deinen Pfad rein



  If Len(Dir$(strPath, vbDirectory)) > 0 Then

    If GetXLFiles(astrXLFiles(), strPath, True) Then



      For nFile = 0 To UBound(astrXLFiles)

      'hierist die def nur Für Spalte A APASSEN

        For zz = 1 To 4

            With ActiveWorkbook.Worksheets(1).Cells(Cells(65536, 1).End(xlUp).Row + 1, 1)

            

              .Formula = "='" & strPath & "[" & Replace(astrXLFiles(nFile), strPath, "") & "]Tabelle1'!A" & zz

              .Value = .Value

             

              End With

          Next zz

      Next

      Erase astrXLFiles

    End If

  End If

End Sub

  



Code eingefügt mit Syntaxhighlighter 3.0







p.s ich habe das mit vb-fun zusammengebastelt


Feedback nicht vergessen ! Gutes gelingen wünscht Chris

I didn't write this; a very complex macro did.

0110110001101001011001010110001001100101001000000110011101110010111111001101111101100101001000000110001101101000011100100110100101110011

geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: