Datum

Titel

26.04.2024 16:22:47

Aktualisierung Verknüpfung bei geschlossener Quelldatei

26.04.2024 16:05:28

PivotChart-Stapeldiagramm erstellen

26.04.2024 15:34:42

Überlagernde Textbox-Ansicht

26.04.2024 15:27:20

Excel öffnet nach Auswahl einer Excel diese leer

Du findest keine passende Antwort auf Deine Frage?

Stelle Deine Frage in unserem Live-Forum

Archiv - Navigation

1800to1804

Aktuelles Verzeichnis

Verzeichnis Index

Übersicht Verzeichnisse

Vorheriger Thread

Rückwärts Blättern

Nächster Thread

Vorwärts blättern

HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Vorwärts blättern

Inhaltsverzeichnis

VBA Doppelte Werte Abfrage und Kopieren

Forumthread: VBA Doppelte Werte Abfrage und Kopieren
7 Beiträge zu diesem Forumthread
Anzeige
325 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen

Excel Dialoge
Top 100 Forumthreads

29.12.2020 20:32:38

Marko

Hallo,
ich habe einen Code zum Kopieren von Werten und benötige hierzu die Prüfung, ob in "Tabelle6" Spalte A bereits der zu kopierenden Wert aus "Tabelle19" Zelle N1 bereits vorhanden ist. Wenn der Wert bereits in "Tabelle6" Spalte A vorhanden ist, dann soll sich eine MsgBox mit der Abfrage, ob diese Zeile (bei Ja) mit den Werten aus "Tabelle19" N1 bis R1 überschrieben werden soll, oder (bei Nein) die Eingabe abgebrochen soll,
Vielen Dank für Eure Hilfe.

Private Sub CommandButton1_Click()
Sheets("Tabelle19").Range("N1:R1").Copy
Sheets("Tabelle6").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range("G4, G6, G8, G10").ClearContents
End Sub

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Doppelte Werte Abfrage und Kopieren

29.12.2020 23:06:18

ralf_b
update

30.12.2020 10:25:20

ralf_b
Frage

30.12.2020 10:38:00

Marko
AW: Frage

30.12.2020 11:02:13

ralf_b
AW: Prüfung

30.12.2020 09:13:30

GerdL
Überschreiben

30.12.2020 09:45:42

Marko
AW: Überschreiben

30.12.2020 14:36:18

GerdL

AW: VBA Doppelte Werte Abfrage und Kopieren

29.12.2020 23:06:18

ralf_b

ungetestet, viel Spass


dim fund as range, bcopy as boolean
with Sheets("Tabelle6").Range("A1:A" & .Cells(rows.count,1).end(xlup).row)
set fund = .find(What:=Sheets("Tabelle19").Range("N1"), lookin:=XlVAlues, Lookat:=XlWhole)
if not fund is nothing then
if vbyes= msgbox("Wert vorhanden. Überschreiben?", vbyesno) then
bcopy = true
else
bcopy = false
end if
else
bcopy =true
end if
if bcopy then
Sheets("Tabelle19").Range("N1:R1").Copy
Sheets("Tabelle6").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range("G4, G6, G8, G10").ClearContents
end if
end with

update

30.12.2020 10:25:20

ralf_b

die zu überschreibende Zeile war mir durchgerutscht. der Vollständigkeit halber.


Dim fund As Range, bcopy As Boolean, fundzeile As Long
With Sheets("Tabelle6").Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set fund = .Find(What:=Sheets("Tabelle19").Range("N1").Value, LookIn:=xlValues, Lookat:=xlWhole) _
If Not fund Is Nothing Then
If vbYes = MsgBox("Wert vorhanden. Überschreiben?", vbYesNo) Then
bcopy = True
fundzeile = fund.Row
Else
bcopy = False
End If
Set fund = Nothing
Else
bcopy = True
End If
If bcopy Then
Sheets("Tabelle19").Range("N1:R1").Copy
If fundzeile > 0 Then
Sheets("Tabelle6").Cells(fundzeile, 1).PasteSpecial xlPasteValues
Else
Sheets("Tabelle6").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial  _
xlPasteValues
End If
Application.CutCopyMode = False
Range("G4, G6, G8, G10").ClearContents
End If

Frage

30.12.2020 10:38:00

Marko

Hallo Ralf,
vielen Dank für den Code. Nun will dieser Code mein "Private Sub CommandButton1_Click()" nicht?
Woran kann das liegen?

AW: Frage

30.12.2020 11:02:13

ralf_b

der Code soll doch da rein, oder? Dann ersetze den alten Code durch den Neuen an der passenden Stelle.
Du solltest auch schon mitbekommen haben das deine Fehlerbeschreibungen nichts taugen. Zu wenig hilfreiche Informationen für Jemanden, der nicht vor deiner Datei sitzt.

AW: Prüfung

30.12.2020 09:13:30

GerdL

Moin

Dim X As Variant
X = Sheets("Tabelle19").Range("N1").Value
If WorksheetFunction.CountIf(Sheets("Tabelle6").Columns("A"), X) > 0 Then
If MsgBox("Der Wert " & CStr(X) & " ist schon vorhanden. Trotzdem erneut einfügen?",  _
vbYesNo) = vbNo Then Exit Sub
End If

Gruß Gerd

Überschreiben

30.12.2020 09:45:42

Marko

Hallo Gerd, vielen Dank.
Kannst Du mir bitte weiterhin behilflich sein?
Mit welchem Code kann die Eingabe, die bereits in Tabelle6 vorhanden ist, mit den Werten aus Tabelle19 überschrieben werden?
Vielen Dank für Deine Hilfe.

AW: Überschreiben

30.12.2020 14:36:18

GerdL

Hallo

Dim X As Variant
X = Sheets("Tabelle19").Range("N1").Value
If WorksheetFunction.CountIf(Sheets("Tabelle6").Columns("A"), X) > 0 Then
If MsgBox("Der Wert " & CStr(X) & " ist schon vorhanden. Trotzdem erneut einfügen?",  _
vbYesNo) = vbNo Then
Exit Sub
Else
Sheets("Tabelle19").Range("N1:R1").Copy
Sheets("Tabelle6").Range("A" & WorksheetFunction.Match(X, Sheets("Tabelle6").Columns("A" _
), 0)).PasteSpecial Paste:=xlPasteValues
End If
End If

Gruß Gerd