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 Code
#1
Hallo,
habe folgendes Problem. Wäre schön wenn mir jemand helfen könnte.
 
 
Im Arbeitsblatt Kopie1 in AG6 erzeuge ich einen Eintrag wenn ich das Kontrollkästchen U6 einen Haken setze.
Durch ein VBA-Programm wird der Inhalt dieser Zelle in das Arbeitsblatt Spielabschnitt H2 übertragen.
Das funktioniert durch ein VBA Programm, welches in Modul 2 steht. (VBA-Programm siehe unten)
Das funktioniert gut.

Mein Problem ist jetzt folgendes:
Durch das VBA-Programm möchte ich aber AG6, AG9, AG12, AG15, AG23, AG26, AG29, AG32, AG40, AG43, AG46, AG49 in das Arbeitsblatt Spielabschnitt H2 übertragen.
Das VBA-Programm habe ich dementsprechend erweitert.
Nur in einer Zelle von AG ist Eintrag, abhängig welches Kontrollkäschen ich im Vorwege betätigt habe.
Aber durch das VBA-Programm lasse ich immer alle AG Zellen in das Arbeitsblatt Spielabschnitt übertragen.
Und alle Überträge gehen in H2.
Das Problem ist derzeit dass nach Übertrag in H2 nichts steht, weil ja auch die leeren Zellen übertragen werden.
Ich dachte, da ja nur in einer AG ein Eintrag ist, dass trotzdem in H2 dann halt der Eintrag übertragen wird.
Passiert aber nicht. Das Programm überträgt auch die leeren Zellen.
Kann man da am VBA Programm was ändern dass trotz Übertrag aller AG Zellen in H2 der eine Eintrag zu sehen ist.

Gruss Markus





Sub kopieren()

    Range("M1:M2").Select
    Selection.Copy
    
    Sheets("Spielabschnitt").Select
    Range("AR1").PasteSpecial Paste:=xlPasteValues
   
Sheets(Range("AR1").Value).Select
    Range("AG6").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG9").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG12").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG15").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG23").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG26").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG29").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG32").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG40").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG43").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG46").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
         
Sheets(Range("AR1").Value).Select
    Range("AG49").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
                                                                              
Sheets(Range("AR1").Value).Select
    Range("G38").Select
    Selection.Copy
    Range("L1").Select
    Sheets("Spielabschnitt").Select
    Range("AI" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
     
  Application.CutCopyMode = False
   
End Sub
Antworten Top
#2
Ich möchte noch einmal versuchen mein Problem allgemein darzustellen, vielleicht wird es dann verständlicher.

Ich möchte die Einträge aus ca. 15 Zellen eines Arbeitsblattes in EINE Zelle eines anderen Arbeitsblattes übertragen.
Es ist immer nur in einer der 15 Zellen einen Eintrag!
Durch das VBA-Programm lasse ich aber immer alle 15 Zellen übertragen, weil in welcher einen Zelle der 15 Zellen der Eintrag ist, ist unterschiedlich.
Wie kann ich das anstellen, dass trotz Übertrag der 15 Zellen in die eine Zelle auch der eine Eintrag übertragen übernommen wird und nicht wie ich zur Zeit das Problem habe, dass durch den Übertrag gar nichts in der einen Zelle steht.

Wenn ich durch das VBA Programm nur die eine einzige Zelle mit Inhalt übertragen lasse, funktioniert der Übertrag.
Nur wenn ich alle 15 Zellen übertragen lasse, obwohl wie gesagt nur in einer Zelle ein Eintrag ist, wird nichts übertragen.
Das VBA Programm überträgt auch den leeren Inhalt und somit wird nichts in der einen Zelle angezeigt.

Huh
Antworten Top
#3
Besteht irgendie die Möglichkeit eines Zusatzes in jedem Teilprogramm,
DASS NUR EIN ÜBERTRAG STATTFINDEN SOLL, wenn auch ein tatsächlicher Eintrag in der Zelle vorhanden ist.

Inwieweit müsste man diesen Teil der Formel erweitern:

Sheets(Range("AR1").Value).Select
    Range("AG6").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues



ich würde den Zusatz auf die anderen Absätze übertragen und schauen, ob es geht.
Antworten Top
#4
Hallo,

meinst Du so?
Code:
Sub kopieren()
    Dim rngZelle As Range
    
    Range("M1:M2").Copy

    Worksheets("Spielabschnitt").Range("AR1").PasteSpecial Paste:=xlPasteValues
    
    
    For Each rngZelle In Range("AG9,AG12,AG15,AG23,AG26,AG29,AG40,AG43,AG46,AG49")
    
        If rngZelle.Value <> "" Then
            rngZelle.Copy Worksheets("Spielabschnitt").Range("H" & Worksheets("Spielabschnitt").Range("AR2").Value)
            Exit For
        End If
    Next rngZelle
'
'Sheets(Range("AR1").Value).Select
'    Range("G38").Select
'    Selection.Copy
'    Range("L1").Select
'    Sheets("Spielabschnitt").Select
'    Range("AI" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
    
  Application.CutCopyMode = False
  
End Sub
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#5
Danke Stefan,
habe dein Programm mal eingepflegt:
........
Sheets(Range("AR1").Value).Select
    Range("Q10").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("AO" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
    
    For Each rngZelle In Range("AG9,AG12,AG15,AG23,AG26,AG29,AG40,AG43,AG46,AG49")
    
        If rngZelle.Value <> "" Then
            rngZelle.Copy Worksheets("Spielabschnitt").Range("H" & Worksheets("Spielabschnitt").Range("AR2").Value)
            Exit For
        End If
    Next rngZelle
                                                                           
Sheets(Range("AR1").Value).Select
    Range("G38").Select
    Selection.Copy
    Range("L1").Select
    Sheets("Spielabschnitt").Select
    Range("AI" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues
     
  Application.CutCopyMode = False
   
End Sub


Macht trotzdem keinen Übertrag!

Gruss
Antworten Top
#6
Wie kann ich das hinbekommen dass ich dieses Teilprogramm:

Sheets(Range("AR1").Value).Select
    Range("AG6").Select
    Selection.Copy
    Sheets("Spielabschnitt").Select
    Range("H" & Range("AR2").Value).PasteSpecial Paste:=xlPasteValues



dahingehend erweiter, dass ein Übertrag nur stattfindet wenn auch ein tatsächlicher Eintrag, in dem Falle in Zelle AG6.

Für die Erweiterung muss ich dazu sagen, dass jede AG Zelle noch einer anderen Zelle zugeordnet ist, dass eventuell in die Erweiterung einbezogen werden könnte:
Für AG6 existiert die Zelle AA6. Wenn in AA6 eine 0 steht, dann soll AG6 nach H NICHT übertragen werden.
Wenn in AA6 eine 1 steht, dann soll AG6 nach H übertragen werden.

Ob Null oder 1 dort steht habe ich mit einem Kontrollkästchen gelöst! Ist schön bei youtube unter Kontrollkästchen erklärt, wie man ein Kontrollkästchen einer falsch /wahr Zelle zuordnen kann. Diese falsch/wahr zelle kann man dann einer anderen zelle 0/1 zuordnen.


Für AG9 existiert AA9
usw.
Antworten Top
#7
Hallo Markus,

durch deine total unnötige Selektierung von Tabellenblättern verweist meine Lösung auf das falsche (in dem Fall Spielabschnitt) Tabellenblatt. Hänge bei dem Range noch das Worksheet mit dem passenden Tabellennamen an dann sollte es funktiionieren.

Code:
For Each rngZelle In Worksheets(".....")Range("AG9,AG12,AG15,AG23,AG26,AG29,AG40,AG43,AG46,AG49")
    
        If rngZelle.Value <> "" Then
            rngZelle.Copy Worksheets("Spielabschnitt").Range("H" & Worksheets("Spielabschnitt").Range("AR2").Value)
            Exit For
        End If
    Next rngZelle

Die Punkte musst Du den richtigen Tabellennamen ersetzen!
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Maximus
Antworten Top
#8
Maximus,

mir scheint dein ganzer Aufbau ziemlich chaotisch zu sein.
Wenn es um eine Zahl geht und keine weiteren Zahlen im Bereich AG6:AG49 stehen, dann geht es auch mit einer einfachen Formel:
Code:
=VERWEIS(9^99;Kopie1!$AG$6:$AG$49)
Wir sehen uns!
... Detlef

Meine Beiträge können Ironie oder Sarkasmus enthalten.

Antworten Top
#9
Danke Stefan für deine Mühe.
Ich bekomme das so nicht hin.
Aus einem anderen Grund muß die Erweiterung, dass ein Übertrag nur wenn tatsächlicher Eintrag, sich auf die Zelle beziehen und nicht auf das Arbeitsblatt, weil ich zig Kopien erstellen werde  und dann müsste ich immer wieder den Namen des Arbeitsblattes verändern.

Wenn möglich, könntest du die Erweiterung nur auf AG6 erweitern.

Ich würde das dann auf alle anderen AG Zellen abändern.

Vielleicht hilt dieser Zusatz bei der Erstellung der Erweiterung dass jede AG Zelle noch einer anderen Zelle zugerdnet ist.
Für AG6 existiert die Zelle AA6. Wenn in AA6 eine 0 steht, dann soll AG6 nach H NICHT übertragen werden.
Wenn in AA6 eine 1 steht, dann soll AG6 nach H übertragen werden.

Danke und Gruss
Antworten Top
#10
(06.08.2017, 11:05)shift-del schrieb: Maximus,

mir scheint dein ganzer Aufbau ziemlich chaotisch zu sein.
Wenn es um eine Zahl geht und keine weiteren Zahlen im Bereich AG6:AG49 stehen, dann geht es auch mit einer einfachen Formel:
Code:
=VERWEIS(9^99;Kopie1!$AG$6:$AG$49)

Hi shift, das geht nicht um ein Zahl.
Letzten Endes steht dort ein kleiner Text.
Der Übertrag funktioniert ja mit der bestehenden Formel!

Nur das Programm übertrat stumpf alle AG Zellen nach H2.
Irgenwie müßte das VBA Programm dahingehend geändert werden, dass nur dann der Übertrag erfolgen soll, wenn auch ein Text in den AG Zellen steht.

Eventuell hilft dabei, dass jede AG Zelle noch eine anderen Zelle zugeordnet ist. wie oben beschrieben.

Gruss
Antworten Top


Gehe zu:


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