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.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Zellen einer Zeile in andere Tabelle übernehmen mit Eingabemaske (VBA)

Thema geschlossen 
Baumstrukturmodus
Zellen einer Zeile in andere Tabelle übernehmen mit Eingabemaske (VBA)
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#11
30.10.2019, 12:45 (Dieser Beitrag wurde zuletzt bearbeitet: 30.10.2019, 12:46 von Gast 123.)
Hallo

freut mich auch, die beiden Katzen schlafen gerade auf dem Küchentisch. Zeit für Makro schreiben und fürs Forum.

Der Code ist sehr einfach gehalten, und sucht in der Mitglieder Tabelle nach dem Suchwort. In dem Teil:  With Worksheets("Veränderungen")  suche ich zuerst die letzte Zelle zum Daten unten anhaengen. Dann könnt ihr selbst bestimmen welche Daten aus der Mitgliederliste in die Tabelle Veraenderungen übertragen werden. Zwei Beispiele sind vorgegeben, da müsst ihr aber bitte noch selbst die Buchstaben "zzz" für Ziel Spalten und "qqq" für die Quellspalten durch den richtigen Spaltenbuchstaben ersetzen. Dann sollte das Makro laufen.

Was ihr jetzt aus welchen Spalten wohin kopiert ist eure Sache.  Die Kopierzeilen könnt ihr beliebig erweitern.  Viel Spass beim Testen .... 

mfg Gast 123

Code:
Sub Daten_übertragen()
Dim strSuchwort As String, lz1 As Long
Dim MTG As Worksheet, mtFind As Range

  On Error GoTo Fehler
  strSuchwort = InputBox("Welches Suchwort?", "Suchwort eingeben")
  If strSuchwort = Empty Then Exit Sub
 
  Set MTG = Worksheets("Mitglieder")
  'Sucht in Mitglieder die richtige Zelle in Spalte B
  Set mtFind = MTG.Range("B:B").Find(What:=strSuchwort, After:=[b2], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

  If mtFind Is Nothing Then MsgBox strSuchwort & "  nicht gefunden": Exit Sub
 
  With Worksheets("Veränderungen")
     'Letzte Zeile in "Veränderungen" suchen (+1)
     lz1 = .Cells(Rows.Count, 2).End(xlUp).Row + 1
     'jetzt in die gefundenen Zeilen Werte übertragen
     '** zzz=Ziel Spalte angeben, qqq=Quelle Spalte angeben
     .Cells(lz1, "zzz").Value = MTG.Cells(mtFind.Row, "qqq").Value
     .Cells(lz1, "zzz").Value = MTG.Cells(mtFind.Row, "qqq").Value
'usw. ... beliebig erweiterbar
  End With
Exit Sub
Fehler: MsgBox "unerwarteter Fehler:" & vbLf & Error()
End Sub
Hallo

freut mich auch, die beiden Katzen schlafen gerade auf dem Küchentisch. Zeit für Makro schreiben und fürs Forum.

Der Code ist sehr einfach gehalten, und sucht in der Mitglieder Tabelle nach dem Suchwort. In dem Teil:  With Worksheets("Veränderungen")  suche ich zuerst die letzte Zelle zum Daten unten anhaengen. Dann könnt ihr selbst bestimmen welche Daten aus der Mitgliederliste in die Tabelle Veraenderungen übertragen werden. Zwei Beispiele sind vorgegeben, da müsst ihr aber bitte noch selbst die Buchstaben "zzz" für Ziel Spalten und "qqq" für die Quellspalten durch den richtigen Spaltenbuchstaben ersetzen. Dann sollte das Makro laufen.

Was ihr jetzt aus welchen Spalten wohin kopiert ist eure Sache.  Die Kopierzeilen könnt ihr beliebig erweitern.  Viel Spass beim Testen .... 

mfg Gast 123

Code:
Sub Daten_übertragen()
Dim strSuchwort As String, lz1 As Long
Dim MTG As Worksheet, mtFind As Range

  On Error GoTo Fehler
  strSuchwort = InputBox("Welches Suchwort?", "Suchwort eingeben")
  If strSuchwort = Empty Then Exit Sub
 
  Set MTG = Worksheets("Mitglieder")
  'Sucht in Mitglieder die richtige Zelle in Spalte B
  Set mtFind = MTG.Range("B:B").Find(What:=strSuchwort, After:=[b2], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

  If mtFind Is Nothing Then MsgBox strSuchwort & "  nicht gefunden": Exit Sub
 
  With Worksheets("Veränderungen")
     'Letzte Zeile in "Veränderungen" suchen (+1)
     lz1 = .Cells(Rows.Count, 2).End(xlUp).Row + 1
     'jetzt in die gefundenen Zeilen Werte übertragen
     '** zzz=Ziel Spalte angeben, qqq=Quelle Spalte angeben
     .Cells(lz1, "zzz").Value = MTG.Cells(mtFind.Row, "qqq").Value
     .Cells(lz1, "zzz").Value = MTG.Cells(mtFind.Row, "qqq").Value
'usw. ... beliebig erweiterbar
  End With
Exit Sub
Fehler: MsgBox "unerwarteter Fehler:" & vbLf & Error()
End Sub
Sorry versehentlich doppelt geklickt.
Suchen
Antworten Top
snb Offline
Benutzer
Registriert seit: 29.09.2015
Version(en): 2030,5
#12
30.10.2019, 12:57
(30.10.2019, 10:49)mdt8ws schrieb: A Gibt es eventuell einen Code (Beispiel) für mein geplantes Vorhaben ?

MfG
mdt8ws

Wo ist deine Beispieldatei mit geplantes Vorhaben ?
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Homepage Suchen
Antworten Top
mdt8ws Offline
Benutzer
ThreadStarter

Registriert seit: 29.10.2019
Version(en): 365
#13
30.10.2019, 13:35
Vielen Dank !
Werde ich heute Nachmittag noch ausprobieren. Melde mich dann wieder.

MfG
mdt8ws
Suchen
Antworten Top
mdt8ws Offline
Benutzer
ThreadStarter

Registriert seit: 29.10.2019
Version(en): 365
#14
30.10.2019, 18:23
Hallo Gast 123,
ich bin absolut beeindruckt, genau das habe ich gesucht. Das Übertragen der Zellwerte funktioniert einwandfrei.
Ich habe jedoch noch Fragen:

1.) Das Übertragen funktioniert mit den angepassten Spalten einwandfrei. Sobald ich aber den nächsten Datensatz
übertragen habe, wird der vorher kopierte überschrieben. Wir möchten gerne, dass die Datensätze in der Tabelle "Veränderungen" untereinander fortgeschrieben werden.
Ist das eventuell möglich ?

2.) In der Tabelle "Mitglieder" sind in der Spalte K die Geburtsdaten (Format TT.MM.JJJJ) enthalten.
Wir möchten gerne im Suchfeld das Geburtsdatum eingeben (also nicht mehr in Spalte B nach Werten suchen), so dass dann nach Bestätigung dieser Eingabe
die Daten übertragen werden. Ich habe das schon entsprechend angepasst, funktioniert aber bei mir nicht.
Es gibt auch 3 doppelte Geburtstage in der Tabelle "Mitglieder", soll heißen, daß bei der Eingabe von einem Geburtsdatum dieser doppelten Daten auch
2 Datensätze (sind z. B. Zwillinge als Mitglieder) in die Tabelle "Veränderungen" übertragen werden.

3.) Und die letzte Frage die habe (ist aber nicht so wichtig):
Besteht die Möglichkeit aus der Tabelle "Mitglieder" beim Übertragen auch die Formatierung z. B. Zellrahmen (nicht die Formeln) zu übernehmen ?

Kann ich eventuell nochmal einen angepassten Code bekommen ?
Vielen Dank , ich hoffe dass ich nicht zu sehr nerve !

MfG
mdt8ws
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#15
31.10.2019, 01:28
Hallo

anbei ein überarbeiteter Code für Suchen in Spalte K nach Geb.Datum.  Zum kopieren sind jetzt pro Zelle drei Befehle nötig. Das Prinzip ist einfach zu verstehen. Wird im Suchlauf der Range Bereich veraendert, muss m Makro auch die Start Adresse mit geaendert werden:  After:=[k2].

Beachtet bitte das ich die LastZelle zum unten anhaengen in Spalte A suche. Da dürfen KEINE Leerzellen sein!!  Beim kopieren dient der 1. Paste Special Befeh zum kopieren der Rahmen und Formate. Stehen in der Zelle Formeln wird die Formel mit kopiert. Der nachfolgende Paste Befehl mit xlPasteValues kopiert dann die Werte.  Ich denke damit sind alle Wünsche abgedeckt.
  
mfg Gast 123

Code:
Sub Daten_übertragen()
Dim strSuchwort As Variant, lz1 As Long
Dim MTG As Worksheet, mtFind As Range
Dim Adr1 As String, wh As Integer
 
On Error GoTo Fehler
'3x Eingabe wiederholen wenn ungültiges Datum eingegeben wird
neu: strSuchwort = InputBox("Welches Suchwort?", "Suchwort eingeben")
    If strSuchwort = Empty Then Exit Sub
    If Not IsDate(strSuchwort) Then
        MsgBox "Kein gültiges Datum"
        If wh >= 2 Then Exit Sub
        wh = wh + 1: GoTo neu
    End If
 
  Set MTG = Worksheets("Mitglieder")
  'Sucht in Mitglieder die richtige Zelle in Spalte B
  Set mtFind = MTG.Range("K:K").Find(What:=CDate(strSuchwort), After:=[K2], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

  If mtFind Is Nothing Then MsgBox strSuchwort & "  nicht gefunden": Exit Sub
 
  With Worksheets("Veränderungen")
     'Letzte Zeile in Spalte A suchen (+1)
     lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
     Adr1 = mtFind.Address  'für Do Loop notieren
     'jetzt in die gefundenen Zeilen Werte übertragen
     '** zzz=Ziel Spalte angeben, qqq=Quelle Spalte angeben
     Do
        lz1 = lz1 + 1  'LastZell +1 setzen
        'alle Zellen kopieren und mit Format einfügen  (xlPasteAll)
        MTG.Cells(mtFind.Row, "A").Copy
        Cells(lz1, "A").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "A").PasteSpecial xlPasteValues  'kopiert Zell-Werte
     
        MTG.Cells(mtFind.Row, "B").Copy
        Cells(lz1, "B").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "B").PasteSpecial xlPasteValues  'kopiert Zell-Werte
       'Kopiermodus zum Schluss ausschalten!
       Application.CutCopyMode = False
             
       Set mtFind = MTG.Range("K:K").FindNext(mtFind)
       If mtFind Is Nothing Then Exit Sub
    Loop Until Adr1 = mtFind.Address
  End With
Exit Sub
Fehler: MsgBox "unerwarteter Fehler:" & vbLf & Error()
End Sub
Suchen
Antworten Top
mdt8ws Offline
Benutzer
ThreadStarter

Registriert seit: 29.10.2019
Version(en): 365
#16
31.10.2019, 10:38 (Dieser Beitrag wurde zuletzt bearbeitet: 31.10.2019, 10:43 von WillWissen. Bearbeitungsgrund: Codetags )
Hallo Gast 123,

super, total Klasse wir sind fast am Ziel.

Habe jetzt noch 2 Fragen/Anmerkungen zum Code:

Wenn ich den Code wie nachfolgend beigefügt ausführe, dann werden die Zellen einmal nur als Werte kopiert und dann nochmal
in die nächste Zeile mit Werten und den Formaten, also doppelt. Ist das noch zu ändern ?

Ist es möglich den Code noch so zu ändern, dass die Last Zelle zum unten anhängen in Spalte C gesucht wird ?

Ansonsten alles andere TOP !!!!

Nachfolgend der von mir geänderte Code oder habe ich da einen Denkfehler ?

Vielen, vielen Dank !

MfG
mdt8ws



Code:
Sub Daten_übertragen()
Dim strSuchwort As Variant, lz1 As Long
Dim MTG As Worksheet, mtFind As Range
Dim Adr1 As String, wh As Integer
 
On Error GoTo Fehler
'3x Eingabe wiederholen wenn ungültiges Datum eingegeben wird
neu: strSuchwort = InputBox("Welches Suchwort?", "Suchwort eingeben")
    If strSuchwort = Empty Then Exit Sub
    If Not IsDate(strSuchwort) Then
        MsgBox "Kein gültiges Datum"
        If wh >= 2 Then Exit Sub
        wh = wh + 1: GoTo neu
    End If
 
  Set MTG = Worksheets("Mitglieder")
  'Sucht in Mitglieder die richtige Zelle in Spalte K
  Set mtFind = MTG.Range("K:K").Find(What:=CDate(strSuchwort), After:=[K2], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

  If mtFind Is Nothing Then MsgBox strSuchwort & "  nicht gefunden": Exit Sub
 
  With Worksheets("Veränderungen")
     'Letzte Zeile in Spalte A suchen (+1)
     lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
     Adr1 = mtFind.Address  'für Do Loop notieren
     'jetzt in die gefundenen Zeilen Werte übertragen
     '** zzz=Ziel Spalte angeben, qqq=Quelle Spalte angeben
     .Cells(lz1, "C").Value = MTG.Cells(mtFind.Row, "A").Value
     .Cells(lz1, "D").Value = MTG.Cells(mtFind.Row, "B").Value
     Do
        lz1 = lz1 + 1  'LastZell +1 setzen
        'alle Zellen kopieren und mit Format einfügen  (xlPasteAll)
        MTG.Cells(mtFind.Row, "A").Copy
        Cells(lz1, "C").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "C").PasteSpecial xlPasteValues  'kopiert Zell-Werte
     
        MTG.Cells(mtFind.Row, "B").Copy
        Cells(lz1, "D").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "D").PasteSpecial xlPasteValues  'kopiert Zell-Werte
       'Kopiermodus zum Schluss ausschalten!
       Application.CutCopyMode = False
             
       Set mtFind = MTG.Range("K:K").FindNext(mtFind)
       If mtFind Is Nothing Then Exit Sub
    Loop Until Adr1 = mtFind.Address
  End With
Exit Sub
Fehler: MsgBox "unerwarteter Fehler:" & vbLf & Error()
End Sub
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#17
31.10.2019, 21:32
Hallo

Sorry das ich mich jetzt erst melde, bin nicht staendig im Forum. 
Freut mich das der Code soweit klappt. Die LastZell in C suchen ist einfach. s. den Codeteil unten.  Hinter Rows.Count die 1 in 3 aendern, das ist alles!
Das ich doppelt kopiere hat mit den Rahmen zu tun, bei Werte kopieren fallen die Rahmen weg. Kopiert man nur xlPasteAll kopiert man auch die Formeln. Die können aber falsche Werte anzeigen, weil Excel eine automatische Zeilen/Spaltenverschiebung macht. Will man Werte mit Fomaten kopieren ist die doppelte Methode am sichersten.

mfg Gast 123

Code:
 With Worksheets("Veränderungen")
    'Letzte Zeile in Spalte A suchen (+1)
    lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
Suchen
Antworten Top
mdt8ws Offline
Benutzer
ThreadStarter

Registriert seit: 29.10.2019
Version(en): 365
#18
02.11.2019, 17:02
Hallo Gast 123,
vielen Dank für die tolle Unterstützung. Jetzt funktioniert alles perfekt !

MfG
mdt8ws
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#19
02.11.2019, 18:50
Hallo

danke für die freundliche Rückmeldung, freut mich sehr ....

mfg Hast 123
Suchen
Antworten Top
mdt8ws Offline
Benutzer
ThreadStarter

Registriert seit: 29.10.2019
Version(en): 365
#20
15.11.2019, 12:30 (Dieser Beitrag wurde zuletzt bearbeitet: 15.11.2019, 12:33 von WillWissen. Bearbeitungsgrund: Codetags )
Hallo Gast 123,

ich habe den nachfolgenden Code angepasst und der funktioniert bei mir perfekt.
Ich habe noch eine Frage dazu:

Die Übernahme der Daten aus der Tabelle Mitglieder erfogt durch die Eingabe des Geburtsdatums in der Tabelle Veränderungen.
Das klappt auch sehr gut. Schön wäre jetzt, wenn nach erfolgter Übernahme der Daten (sind nicht alle Zellen der kompletten Zeile aus der Tabelle Mitglieder)
die komplette Zeile in der Tabelle Mitglieder gelöscht würde.

Ist das eventuell doch eine Anpassung vom Code möglich ?

MfG
Gerhard

Code:
Sub Daten_übertragen()
Dim strSuchwort As Variant, lz1 As Long
Dim MTG As Worksheet, mtFind As Range
Dim Adr1 As String, wh As Integer
 
On Error GoTo Fehler
'3x Eingabe wiederholen wenn ungültiges Datum eingegeben wird
neu: strSuchwort = InputBox("Geburtsdatum eingeben - Format: TT.MM.JJJJ", "Suchmaske")
    If strSuchwort = Empty Then Exit Sub
    If Not IsDate(strSuchwort) Then
        MsgBox "Kein gültiges Datum"
        If wh >= 2 Then Exit Sub
        wh = wh + 1: GoTo neu
    End If
 
  Set MTG = Worksheets("Mitglieder")
  'Sucht in Mitglieder die richtige Zelle in Spalte K
  Set mtFind = MTG.Range("K:K").Find(What:=CDate(strSuchwort), After:=[K2], LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

  If mtFind Is Nothing Then MsgBox strSuchwort & "  nicht gefunden": Exit Sub
 
  With Worksheets("Veränderungen")
     'Letzte Zeile in Spalte A suchen (+1)
     lz1 = .Cells(Rows.Count, 3).End(xlUp).Row
     Adr1 = mtFind.Address  'für Do Loop notieren
     'jetzt in die gefundenen Zeilen Werte übertragen
     '** zzz=Ziel Spalte angeben, qqq=Quelle Spalte angeben
     
     Do
        lz1 = lz1 + 1  'LastZell +1 setzen
        'alle Zellen kopieren und mit Format einfügen  (xlPasteAll)
        
        MTG.Cells(mtFind.Row, "AC").Copy
        Cells(lz1, "A").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "A").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "AD").Copy
        Cells(lz1, "B").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "B").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "A").Copy
        Cells(lz1, "C").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "C").PasteSpecial xlPasteValues  'kopiert Zell-Werte
     
        MTG.Cells(mtFind.Row, "B").Copy
        Cells(lz1, "D").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "D").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "C").Copy
        Cells(lz1, "E").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "E").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "D").Copy
        Cells(lz1, "F").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "F").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "E").Copy
        Cells(lz1, "G").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "G").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "E").Copy
        Cells(lz1, "G").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "G").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "F").Copy
        Cells(lz1, "H").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "H").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "J").Copy
        Cells(lz1, "I").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "I").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "K").Copy
        Cells(lz1, "J").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "J").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "O").Copy
        Cells(lz1, "K").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "K").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "T").Copy
        Cells(lz1, "L").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "L").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "U").Copy
        Cells(lz1, "M").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "M").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "P").Copy
        Cells(lz1, "N").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "N").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "O").Copy
        Cells(lz1, "K").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "K").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "Q").Copy
        Cells(lz1, "O").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "O").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "R").Copy
        Cells(lz1, "P").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "P").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "W").Copy
        Cells(lz1, "Q").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "Q").PasteSpecial xlPasteValues  'kopiert Zell-Werte
        
        MTG.Cells(mtFind.Row, "AB").Copy
        Cells(lz1, "R").PasteSpecial xlPasteAll     'kopiert Zellformate
        Cells(lz1, "R").PasteSpecial xlPasteValues  'kopiert Zell-Werte
               
       'Kopiermodus zum Schluss ausschalten!
       Application.CutCopyMode = False
             
       Set mtFind = MTG.Range("K:K").FindNext(mtFind)
       If mtFind Is Nothing Then Exit Sub
    Loop Until Adr1 = mtFind.Address
  End With
Exit Sub
Fehler: MsgBox "unerwarteter Fehler:" & vbLf & Error()
End Sub
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


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