Thema Datum  Von Nutzer Rating
Antwort
Rot Daten untereinander einfügen und nicht überschreiben lassen
27.11.2017 15:24:05 Aston
NotSolved
27.11.2017 16:40:03 Werner
NotSolved
27.11.2017 17:03:30 Gast55207
NotSolved

Ansicht des Beitrags:
Von:
Aston
Datum:
27.11.2017 15:24:05
Views:
1111
Rating: Antwort:
  Ja
Thema:
Daten untereinander einfügen und nicht überschreiben lassen

Hallo Leute 

 

Könnt ihr mir bei meinem Problem helfen. Ich möchte Daten aus verschiedene Files zusammen 

in einem File packen. Mein Code macht gerade folgendes: Er geht durch einen Ordner mit verschiedenen Files, wenn eine bestimmte Bedingung erfüllt wird, kommen die Daten aus diesem File in ein anderes File Namens B. Mein Problem ist, wenn z.B ein neues File in diesem bestimmten Ordner kommt und ich dann das Makro durchführe werden die neuen Daten im File B nicht unten eingefügt, sondern überschrieben die bestehenden Daten. Ich weiss es liegt daran, dass ich die Startzeile auf 3 gesetzt habe und jedes Mal wenn ich das Makro durchführe beginnt es natürlich die Daten aus den verschiedenen File ab Zeile 3 einzufügen. Wie kann ich das jedoch ändern.

 

Hoffe das ihr mir helfen könnt ??.  


Option Explicit
Option Compare Text

Const Folder = "D:\Test_Umgebung\Orders_xlsx"

Const StartZeile = 3


Public Sub test2()

    
    Dim Datei As String
    Dim Verzeichnis As String
    Dim SaveDummy As Variant
    Dim Datum As Date
    Dim num As String
    Dim Filename As String
    Dim aktDate As Date
    Dim Wkb As Workbook, Fso As Object, file As Object, Zeile As Long
    Dim Wkb2 As Workbook
    Dim test As String
    
    
    
    
    Zeile = StartZeile
    
    aktDate = "17.10.2017"
    num = "1"
    test = 2
    
    With Application
        .ScreenUpdating = False     'Bildschirmaktualisierung aus
        .AskToUpdateLinks = False   'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren
        .DisplayAlerts = False      'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken
    End With
    
    
    Set Fso = CreateObject("Scripting.FileSystemObject")    'Dateisystem-Operationen
    
    
    
    Workbooks.Open "Testo_" & aktDate & "--" & num & ".xlsx"
    Set Wkb2 = test & "--" & num & ".xlsx")

        
    For Each file In Fso.GetFolder(Folder).Files  'Alle _orders.xlsx-Dateien einlesen und eintragen
        If Fso.GetExtensionName(file.Name) Like "xlsx" And Fso.GetBaseName(file.Name) Like "*orders*" Then
              
           Set Wkb = GetObject(file.Path)
           With Wkb.Sheets(1) 'Werte mit Zahlenformat werden erst geptrüft
           'Ich habe getern eine der gössten
           'Wenn Feld B2 aus dem File orders.xls =
           'das Datum das beim neuen File eingeben wurde dann coppy Restliche Felder
           If Wkb.Sheets(1).Range("B2").Value = aktDate Then
        
        
        
                
            .Range("A2").Copy:  Cells(Zeile, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("B2").Copy:  Cells(Zeile, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("C2").Copy:  Cells(Zeile, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("D2").Copy:  Cells(Zeile, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("E2").Copy:  Cells(Zeile, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("F2").Copy:  Cells(Zeile, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("G2").Copy:  Cells(Zeile, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("H2").Copy:  Cells(Zeile, "H").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("I2").Copy:  Cells(Zeile, "I").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Range("J2").Copy:  Cells(Zeile, "J").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
                         
            End If
            End With
            
            Wkb.Close False:  Zeile = Zeile + 1
             

        End If
        
    Next
    Wkb2.Save
    Workbooks.Close
    
    
    
    
End Sub

 


Ihre Antwort
  • 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: Name: Email:



  • 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
Rot Daten untereinander einfügen und nicht überschreiben lassen
27.11.2017 15:24:05 Aston
NotSolved
27.11.2017 16:40:03 Werner
NotSolved
27.11.2017 17:03:30 Gast55207
NotSolved