| 
                              
                                  Thema
                              
                           | 
                          
                              
                                  Datum 
                           | 
                          
                              
                                  Von Nutzer
                           | 
                          
                              
                                  Rating
                           | 
                          
                               
                                  Antwort 
                           | 
                      
                      
  Dateiname einfügen   | 
19.08.2014 16:28:20 | 
flowmäster | 
 | 
 | 
 | 
19.08.2014 16:31:42 | 
Gast49718 | 
 | 
 | 
 | 
19.08.2014 16:42:40 | 
flowmäster | 
 | 
 | 
 | 
20.08.2014 11:05:41 | 
Gast66749 | 
 | 
 | 
                  
    
                    
             
								 
									
										Von: 
                                            flowmäster | 
										Datum: 
                                            19.08.2014 16:28:20 | 
										Views:
                                             
                                            2797 | 
										Rating:
                                                                          | 
										Antwort: 
                                              
                                            
                                             | 
									
									
										Thema:
                                             
                                            Dateiname einfügen  | 
									
									
										|  
                                            Hallo liebe Community, 
ich hoffe ihr könnt mir bei meinem Problem weiterhelfen. 
Ich habe bereits ein funktionsfähiges Programm, dass mir aus mehreren Excel-Dateien eine Excel-Datei erzeugt. Allerdings möchte ich, dass vor jedem neuen Eintrag der Dateiname der einzufügenden Excel-Datei erscheint. Ich komme da irgendwie nicht so wirklich weiter.  
Hier der bisherige Code: 
Sub Zusammenführen()
    
     Dim i               As Long
     Dim sPfad           As String
     Dim sDatei          As String
     Dim vFileToOpen     As Variant
     Dim lngLZ           As Long
     Dim blnÜberschrift  As Boolean
     Dim iCalc           As Integer
     
     With ActiveSheet
        If .FilterMode Then .ShowAllData
     End With
     
     vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
     If Not IsArray(vFileToOpen) Then Exit Sub
     
         
     iCalc = Application.Calculation
     On Error GoTo ENDE:
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
     Application.EnableEvents = False
     
     
     For i = 1 To UBound(vFileToOpen)
         sDatei = Dir(vFileToOpen(i))
         sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
     
         With Tabelle5.Range("B9")
             .Formula = "=LOOKUP(9,1/('" & sPfad & "[" & sDatei & "]Tabelle5'!$B:$B<>""""),ROW('" & sPfad & "\[" & sDatei & "]Tabelle5'!$B:$B))"
             lngLZ = .Value
         End With
         
         With Tabelle5
             If blnÜberschrift Then
                 .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ - 1, 13).Formula = _
                 "='" & sPfad & "[" & sDatei & "]Tabelle5'!B9"
             Else
                 blnÜberschrift = True
                 .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ, 13).Formula = _
                 "='" & sPfad & "[" & sDatei & "]Tabelle5'!B9"
             End If
         End With
         
         Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
     Next
     
     With Tabelle5.UsedRange
         .Copy
         .PasteSpecial xlPasteValues
         .Rows(2).Delete
     End With
     
ENDE:
     Application.EnableEvents = True
     Application.Calculation = iCalc
     Application.ScreenUpdating = True
     If Err Then MsgBox Err.Description, , "Fehler: " & Err
 End Sub
 Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
     Dim Mess, Z, Rest
     Static oldStatusBar As Integer
     Static blnInit As Boolean
     If Not blnInit Then
         oldStatusBar = Application.DisplayStatusBar
         Application.DisplayStatusBar = True
     End If
     
     Mess = ""
     For Z = 1 To ProzentSatz
         Mess = Mess & ChrW(Val("&H25A0"))
     Next Z
     Rest = 100 - ProzentSatz
     For Z = 1 To Rest
         Mess = Mess & ChrW(Val("&H25A1"))
     Next Z
     Application.StatusBar = Mess & " " & ProzentSatz & "%"
     
     If Rest <= 0 Then
         Application.StatusBar = False
         Application.DisplayStatusBar = oldStatusBar
     End If
 End Sub
     | 
									
								
							
 					
		   
 
                          
                        
                                
                    - Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
 
                                        - Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
 
                        - Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
 
                        - Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
 
                        - Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei 
    Antworten auf Ihren Beitrag zu benachrichtigen
 
                                    
                            
                             
                          
	
                         
                                  
                             
                             Bitte geben Sie ein aussagekräftiges Thema an. 
                            
                            Bitte geben Sie eine gültige Email Adresse ein!
                            
                            
                       
                                - Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
 
                                        - Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
 
                        - Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
 
                        - Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
 
                        - Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei 
    Antworten auf Ihren Beitrag zu benachrichtigen
 
                                    
                        
                            
                        
                         
                                                  
 
                                       
                            
                      
                          | 
                              
                                  Thema                               
                           | 
                          
                              
                                  Datum 
                           | 
                          
                              
                                  Von Nutzer
                           | 
                          
                              
                                  Rating
                           | 
                          
                               
                                  Antwort 
                           | 
                      
                      
  Dateiname einfügen   | 
19.08.2014 16:28:20 | 
flowmäster | 
 | 
 | 
 | 
19.08.2014 16:31:42 | 
Gast49718 | 
 | 
 | 
 | 
19.08.2014 16:42:40 | 
flowmäster | 
 | 
 | 
 | 
20.08.2014 11:05:41 | 
Gast66749 | 
 | 
 |