Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA; Nur Werte kopieren
#1
Hallo zusammen,

ich hätte da mal wieder eine Frage bzw. ein kleines Problem bei dem ihr mir hoffentlich helfen könnt Smile

Folgendes Makro habe ich mir zusammengebaut:
Ich gebe in Tabellenblatt1 (M28:M47) einen Namen ein. Anschließend soll mir das Makro diesen Namen in Tabellenblatt2 (V7:V66) suchen und die hinter dem jeweiligen Namen in derselben Zeile in weiteren Zellen aufgeführten Begriffe ebenfalls in Tabellenblatt1 hinter den jeweiligen Namen kopieren.

Da das Makro automatisch ablaufen soll, habe ich es direkt unter Excel Objekte in Tabelle1 eingefügt. Es rödelt zwar immer etwas, funktioniert aber wie gewünscht. Das Problem ist allerdings, dass er mir die Zellinhalte nicht nur als Werte, sondern inkl. Formatierung kopiert. Das will ich aber nicht. Nur leider schaffe ich es nicht, den Code entsprechend zu modifizieren. Ich habe bereits viel ausprobiert (z.B. .PasteSpecial Paste:=xlValues). Allerdings scheint dies wohl mit "Destination:=" nicht zu funktionieren wenn ich richtig recherchiert habe?

Hat jemand eine Idee, wie ich dies trotzdem bewerkstelligen kann? Ich wäre für jeden Tipp sehr dankbar.
Nachfolgend der Code, wie ich ihn mir zusammengebasltet habe:



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim i As Integer
Dim c As Range

If Not Intersect(Target, Range("M28:M47")) Is Nothing Then

    For i = 28 To 47
   
    With Worksheets("Tabellenblatt2").Range("V7:V66")
   
        Set c = .Find(what:=Worksheets("Tabellenblatt1").Cells(i, 13), LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
        If Not c Is Nothing And c.Offset(0, 2).Resize(1, 1) <> "" Then
        c.Offset(0, 2).Resize(1, 1).Copy Destination:=Worksheets("Tabellenblatt1").Cells(i, 14)
        End If
       
        If Not c Is Nothing And c.Offset(0, 3).Resize(1, 1) <> "" Then
        c.Offset(0, 3).Resize(1, 1).Copy Destination:=Worksheets("Tabellenblatt1").Cells(i, 15)
        End If
       
        If Not c Is Nothing And c.Offset(0, 4).Resize(1, 1) <> "" Then
        c.Offset(0, 4).Resize(1, 1).Copy Destination:=Worksheets("Tabellenblatt1").Cells(i, 16)
        End If

    End With

    Set c = Nothing

    Next

End If

End Sub


Danke & Gruß
Sebbo
Antworten Top
#2
Hi,
Du musst den Copy/Paste-Befehl auf Zeilen aufsplitten:

c.Offset(0, 2).Resize(1, 1).Copy
Worksheets("Tabellenblatt1").Cells(i, 14).PasteSpecial Paste:=xlValues

Gruß Regina
Antworten Top
#3
Guten Morgen Regina,

danke für deinen Tipp Smile

Das habe ich auch schon ausprobiert. Dann übernimmt das Makro zwar tatsächlich nur den Wert ohne die Formatierung, allerdings habe ich dann ein weiteres Problem.
Klicke ich auf eine beliebige Zelle (M28:M47) um dort einen Namen einzugeben, springt der Cursor anschließend automatisch aus dieser Zelle und systematisch durch alle Zellen, in welchen schon aufgeführte Begriffe zu bereits hinterlegten Namen stehen, bis er in der letzten angekommen ist.
Das ganze macht das Makro jedes Mal, wenn ich versuche in eine der Zellen für die Namenseingabe zu klicken. Ich habe somit keine Chance mehr einen Namen einzugeben.

Irgendwie verstehe ich das jetzt überhaupt nicht mehr :(

Hast du eine Idee woran das liegen könnte?

Viele Grüße
Sebbo
Antworten Top
#4
... na ja, Du benutzt das Selection-Change-Ereignis, das springt jedesmal an, wenn Du in dem angegebenen Zellbereich eine andere Zelle anklickst. Das hat aber eigentlich nichts mit der "Art" des Einfügens zu tun.
Erklär mal, was Du erreichen willst und lade dazu mal eine Beispieldate hoch.

Gruß Regina
Antworten Top
#5
Hallo Regina,

danke für deine Antwort.
Folgendes möchte ich erreichen:
Wenn ich im Tabellenblatt1 in eine der Zellen M28:M47 klicke und über das DropDown Menü einen Ländernamen auswähle, dass er mir aus Tabellenblatt2 (in welchem alle Daten hinterlegt sind) die zugehörigen Städte zu jedem Land in das Tabellenblatt1 hinter das jeweilige Land kopiert.

Ich habe mal zwei abgespeckte Beispieldateien angehängt.
Die erste, mit dem "Original"-Code, bei welchem ich das DropDown Menü bedienen kann, er mir aber die Formatierung mit kopiert.
Die zweite, mit dem abgeänderten Code, bei welchem er mir nun zwar wie gewünscht nur noch die Werte ohne Formatierung kopiert, ich jedoch nicht mehr das DropDown Menü bedienen kann, weil er mir ständig wieder aus der angewählten Zelle springt.

Ich hoffe mit den Beispielen ist es verständlicher.

Danke und Gruß
Sebbo


Angehängte Dateien
.xlsm   Beispiel_ohne_Formatierung.xlsm (Größe: 19,49 KB / Downloads: 3)
.xlsm   Beispiel_mit_Formatierung.xlsm (Größe: 19,38 KB / Downloads: 2)
Antworten Top
#6
... dann würde ich das Change-Ereignis nehmen:

PHP-Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim c 
As Range

If Target.Column 13 Then

    
For 28 To 47
   
    With Worksheets
("Tabelle2").Range("V7:V66")
   
        Set c 
= .Find(what:=Worksheets("Tabelle1").Cells(i13), LookIn:=xlValueslookat:=xlWholesearchdirection:=xlPrevious)
        If Not c Is Nothing And c.Offset(02).Resize(11) <> "" Then
        c
.Offset(02).Resize(11).Copy
        Worksheets
("Tabelle1").Cells(i14).PasteSpecial Paste:=xlValues
        End 
If
       
        
If Not c Is Nothing And c.Offset(03).Resize(11) <> "" Then
        c
.Offset(03).Resize(11).Copy
        Worksheets
("Tabelle1").Cells(i15).PasteSpecial Paste:=xlValues
        End 
If
       
        
If Not c Is Nothing And c.Offset(04).Resize(11) <> "" Then
        c
.Offset(04).Resize(11).Copy
        Worksheets
("Tabelle1").Cells(i16).PasteSpecial Paste:=xlValues
        End 
If

    End With

    Set c 
Nothing

    Next

End 
If

End Sub 
Gruß Regina
Antworten Top
#7
Juhu, ich sage herzlichen Dank für deine Hilfe! Smile

Ich habe noch eine kleine Anpassung vorgenommen, dass er nur die Zeile durchläuft, die auch geändert wird, aber jetzt funktioniert es genau so wie ich es mir erhofft habe.

Nochmal vielen Dank, ich hätte es alleine nicht hin bekommen!

Grüße
Sebbo
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste