Daten in Mastertabelle anhand ID abgleichen

Hallo zusammen,
ich habe zwar eine Idee jedoch reichen mal wieder meine VBA Kenntnisse zur Umsetzung nicht aus... folgendes Problem:
Ich habe eine Tabelle mit Umsätzen für das aktuelle Jahr (Spalte F bis Q), in Spalte A befindet sich ein eindeutiger Identiefier, in Spalte B bis E informationen über Kunde, Verantwortlicher, Ort, usw..
Nun exportiere ich die Daten in unterschiedlicher Excel Files je Verantwortlicher und schicke diese an den jeweiligen zur Aktualisierung. Die aktuelisierten Daten erhalte ich nun zurück und möchte diese über ein Makro einlesen. Vorgehensweise sollte wie folt sein:
- Datei auswählen (Sheets sind identisch aufgebaut)
- Vergleich ID
- wenn ID in Master gefunden Abgleich der Daten in Spalte F bis Q und Importflag mit Datum setzen in Spalte S
So kann ich dann die einzelnen Dateien nacheinander importieren und abgleichen.
Danke im Vorraus!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo ?,
nimm mal die verbundenen Zellen in Spalte S raus, sonst kracht das Makro!
Dann probier mal diesen Code.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub collectData()
  Dim objWB As Workbook, objSh As Worksheet, objShTgt As Worksheet
  Dim strFile As String
  Dim lngRow As Long
  Dim vntRet As Variant

  On Error GoTo ErrExit
  GMS

  Set objSh = ActiveSheet

  strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
    "*.xls; *.xlsx; *.xlsm")
  If strFile = CStr(False) Then GoTo ErrExit

  If strFile = ThisWorkbook.FullName Then GoTo ErrExit

  Set objWB = Workbooks.Open(strFile)
  Set objShTgt = objWB.Sheets(objSh.Name)

  With objSh
    For lngRow = 2 To Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
      If .Cells(lngRow, 1) <> "" Then
        vntRet = Application.Match(.Cells(lngRow, 1), objShTgt.Columns(1), 0)
        If IsNumeric(vntRet) Then
          objShTgt.Cells(vntRet, 6).Resize(1, 12).Copy .Cells(lngRow, 6)
          .Cells(lngRow, 19) = "Update - " & Format(Now, "dd.MM.yy hh:mm:ss")
        End If
      End If
    Next
  End With

  objWB.Close False

  ErrExit:
  If Err.Number <> 0 Then
    MsgBox "Fehler:" & vbTab & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
  End If

  GMS True

  Set objShTgt = Nothing
  Set objSh = Nothing
  Set objWB = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)

  Static lngCalc As Long

  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
  End With

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Daten in Mastertabelle anhand ID abgleichen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten in Mastertabelle anhand ID abgleichen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread