Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
668to672
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
668to672
668to672
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro erweitern

Makro erweitern
18.09.2005 22:01:46
Josef
Guten Tag zusammen!
Habe ein Problem, dass ich alleine nicht lösen kann.
Mit unten stehenden Makro, frage ich aus Sheet1 Spalte A,ob in Sheet2 Spalte A,
beide Kennummern identisch sind und wenn ja, soll der Wert in Sheet1 Spalte F,
mit dem Wert aus Sheet2 Spalte E, aktualisiert werden. In Sheet2, stehen immer die neuesten Daten, die sich täglich ändern. Unten stehendes Makro erledigt das auch alles Super.
Nun mein Problem: In Sheet2 werden öfter komplett neue Datensätze erfasst, die in Sheet1 noch nicht stehen. Ich möchte erreichen, dass wenn ein neuer Datensatz in Sheet2 existiert, die komplette Zeile nach Sheet1 kopiert wird.
Die beiden Sheets, haben die gleiche Struktur und nur Werte, keine Formeln.
Sheets(1).Activate
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Wert = Cells(i, 1).Value
With Sheets(2).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
If Cells(i, 6) C(1, 5) Then Cells(i, 6) = C(1, 5)
End If
End With
Next i
Kann mir dabei bitte jemand helfen?
Gruß
Josef

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro erweitern
18.09.2005 22:32:19
Josef
Hallo Namensvetter!
Probier mal.
Sub CheckAndCopy()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim lastRow As Long, n As Long
Dim i As Integer

Set sht1 = Sheets(1)
Set sht2 = Sheets(2)

lastRow = sht2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastRow
  Set rng = sht1.Columns(1).Find(sht2.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
  If Not rng Is Nothing Then
    If sht2.Cells(i, 5) <> sht1.Cells(rng.Row, 6) Then sht1.Cells(rng.Row, 6) = sht2.Cells(i, 5)
  Else
    n = n + 1
    sht1.Rows(sht1.Cells(Rows.Count, 1).End(xlUp).Row + 1) = sht2.Rows(i).Value
  End If
Next i

End Sub



'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Makro erweitern
18.09.2005 22:57:25
Josef
Hallo Sepp,
Deine Programmierung wie immer, Super!!! Funktioniert alles einwandfrei.
Bedanke mich sehr!
Gruß aus Köln
Josef

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige