Daten Import via Makro

Thilo · 2019-01-18T08:31:53+00:00

Hallo liebe Excel und VBA Freaks, ich habe ein Excel-File Auswertung) in welchem ich Daten auswerte. Aufbau. Zelle A = Wiegescheinnummer (explizit) ID; Zelle B = Tonnage Ich habe ein zweites Excel-File (Waage) mit dem gleichen Aufbau in dieses die Waage automatisch die Werte schreibt. Nun hätte ich gerne ein Makro mit welchem ich die Werte aus dem File Waage in das File Auswertung Importieren kann (klick Funktion im File Auswertung) Wichtig dabei wäre noch, dass nur die Werte importiert die noch nicht in Der Auswertungstabelle sind. Optimal wäre es wenn man den Speicherort für das Waage-File ändern könnte da dieses per Mail zugesendet wird. Es wäre super wenn es dafür eine Lösung gibt. :-) Viele Grüße Thilo

Hallo
versuch das mal

Option Explicit

Sub Importieren()
    Dim WB1, TB1, LR1 As Long
    Dim WDatei As String, WB2, TB2, LR2 As Long
    Dim Letzte As Long, Zeile As Long, Pfad As String
    Dim Dlg As FileDialog
    
    Set WB1 = ThisWorkbook
    Set TB1 = WB1.Sheets(1)
    
    WDatei = "Wiegedaten.xlsx" 'Name der Importdatei >>> anpassen 
    
    Application.ScreenUpdating = False
    
    LR1 = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
    
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen 
    Dlg.InitialFileName = ThisWorkbook.Path 'Welches Verzeichnis soll voreingestellt sein 
    
    If Dlg.Show Then
        Pfad = Dlg.SelectedItems(1) & "\" 'gewählter Pfad 
        
        'Datei öffnen 
        Set WB2 = Workbooks.Open(Pfad & WDatei)
        Set TB2 = WB2.Sheets(1)
            
        Letzte = TB1.Cells(LR1, 1) 'letzte importierter Wiegeschein 
        Zeile = WorksheetFunction.Match(Letzte, TB2.Columns(1)) 'gefunden in Zeile 
        LR2 = TB2.Cells(TB2.Rows.Count, "A").End(xlUp).Row 'unterster Wiegeschein 
        
        'Import 
        TB1.Cells(LR1 + 1, 1).Resize(LR2 - Zeile, 2).Value = TB2.Cells(Zeile + 1, 1).Resize(LR2 - Zeile, 2).Value
        
        WB2.Close False 'Datei schließen ohne Speichern 
        
    Else
        MsgBox "Abbruch", vbCritical
    End If
End Sub

LG UweD

Hallo nochmal
Ich hab noch 2 Variable reingenommen, dadurch bist du flexibel.

Option Explicit

Sub Importieren()
    Dim WB1, TB1, LR1 As Long, SP As Integer, AnzSP As Integer
    Dim WDatei As String, WB2, TB2, LR2 As Long
    Dim Letzte As Long, Zeile As Long, Pfad As String
    Dim Dlg As FileDialog
    
    Set WB1 = ThisWorkbook
    Set TB1 = WB1.Sheets(1)
    
    WDatei = "Wiegedaten.xlsx" 'Name der Importdatei >>> anpassen 
    SP = 1 'erste Spalte, die mit der WägescheinNr. 
    AnzSP = 3 'Anzahl Spalten hier A-C 
    
    
    Application.ScreenUpdating = False
    
    LR1 = TB1.Cells(TB1.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte A 
    
    Set Dlg = Application.FileDialog(msoFileDialogFolderPicker) 'Verzeichnis wählen 
    Dlg.InitialFileName = ThisWorkbook.Path 'Welches Verzeichnis soll voreingestellt sein 
    
    If Dlg.Show Then
        Pfad = Dlg.SelectedItems(1) & "\" 'gewählter Pfad 
        
        'Datei öffnen 
        Set WB2 = Workbooks.Open(Pfad & WDatei)
        Set TB2 = WB2.Sheets(1)
            
        Letzte = TB1.Cells(LR1, SP) 'letzter bereits importierter Wiegeschein 
        Zeile = WorksheetFunction.Match(Letzte, TB2.Columns(SP)) 'gefunden in Zeile 
        LR2 = TB2.Cells(TB2.Rows.Count, SP).End(xlUp).Row 'unterster Wiegeschein 
        
        'Import 
        TB1.Cells(LR1 + 1, SP).Resize(LR2 - Zeile, AnzSP).Value = TB2.Cells(Zeile + 1, SP).Resize(LR2 - Zeile, AnzSP).Value
        
        WB2.Close False 'Datei schließen ohne Speichern 
        
    Else
        MsgBox "Abbruch", vbCritical
    End If
End Sub

LG UweD

Forumthread: Daten Import via Makro

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial