Office: Makro Unterstützung

Hallo Excel Freunde - ich hoffe Ihr habt den 2. Advent gut überstanden und könnt mir bei folgendem Problem helfen.

Ich habe folgendes Makro:

' jahresdienstbefreiung Makro
' Erstellt eine Kopie der mtl. Dienstbefreiungen für die Jahrestabelle
'

'
Range("A35:H48").Select
Selection.Copy
Sheets("jahrestabelle").Select
Range("A200").Select
Selection.End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle3").Select
Application.CutCopyMode = False
Range("A35").Select
End Sub

Diese Makro soll mir von deer Tabelle2 aus dem Bereich A35:H48 die Werte kopieren und in die Tabelle jahrestabelle an der 1. leeren Zeile die unter der Spalte a gefunden wird einfügen.

Dazu veranlasse ich das Makro von A200 nach oben zu gehen mit ende oben und dann eine Zeile nach unten gehen sonst ist die Zeile ja nicht leer.

Mein Problem besteht nun darin, dass im Bereich A35:H48 alles mit Formeln voll ist und wenn er die Werte überträgt dann nimmt der auch die leeren Zeilen mit und ich habe jedesmal, wenn ich den Bereich neu Kopiere und in die jahrestabell übertrag dazwischen leere Zeilen - was nicht sein soll.

Wie kann man das lösen, ich hoffe, ich habe mich deutlich ausgedrückt.

 

Hallo,

folgendes Makro sollte die Aufgabe erfüllen:

Code:

Public Sub NichtLeereZeilen_Kopieren()
  '
  ' jahresdienstbefreiung Makro
  ' Erstellt eine Kopie der mtl. Dienstbefreiungen für die Jahrestabelle
  '
  Dim Quelle As Range, Ziel As Range, Zeile As Range, Zelle As Range
  Dim IstZeileLeer As Boolean
  
  'Quell- und Zielbereich wie von Dir vorgegeben
  Set Quelle = Range("A35:H48")
  Set Ziel = Sheets("jahrestabelle").Range("A200").End(xlUp).Offset(1)
    
  For Each Zeile In Quelle.Rows
    'Überprüfe, ob die Quellzeile leer ist
    IstZeileLeer = True
    For Each Zelle In Zeile.Cells
      If Not IsEmpty(Zelle) Then IstZeileLeer = False: Exit For
    Next Zelle
    'Quell-Zeile ist gestestet
    If IstZeileLeer Then
      'Sie ist leer: tue nichts
    Else
      'Sie ist nicht leer: kopiere die Zeile (nur Werte) von der Quelle ins Ziel
      Zeile.Copy
      Ziel.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
      'Stelle Zielzeile 1 Zeile tiefer
      Set Ziel = Ziel.Offset(1)
    End If
  Next Zeile
  'Kopiermodus beenden
  Application.CutCopyMode = False
  
End Sub

 

Hallo exl121150 - ich grüße dich,

habe dein Makro ausprobiert - leider funtzt es nicht so wie ich es gerne gehabt hätte, jetzt sind die leerzeilen oben

 

Hallo,

ich habe nur programmiert, was Du mir aufgetragen hast:

Code:

 Set Ziel = Sheets("jahrestabelle").Range("A200").End(xlUp).Offset(1)

Hast Du kontrolliert, ob in der Zelle oberhalb von 'Bergmann' nichts enthalten ist - auch kein Leerzeichen oder etwas ähnlich Unsichtbares?

 

schön das du mir helfen willst - ja es ist nichts drinn nur die Überschriftleiste habe alles noch einmal geleert um sicher zu sein. Wenn ich es zweimal kopiere bleiben dann auch wieder die Leerzeilen so auch beim dritten mal, immer die gleiche Anzahl an leerzeilen. Ich weiß nicht ob von der Tabelle die du ja kennst es mit den Formeln zu tun haben kann. Ich habe schon alles mögliches ausprobiert.

 

Hallo,

ich habe die 'Ziel'-Ermittlung geändert: das Makro sucht jetzt im Arbeitsblatt 'jahrestabelle' nach der Zelle mit dem Text 'a) erkrankte Lehrkräfte' in Spalte A und von dort 3 Zeilen tiefer (also die Zelle unterhalb von 'Name'):

Code:

Public Sub NichtLeereZeilen_Kopieren()
  '
  ' jahresdienstbefreiung Makro
  ' Erstellt eine Kopie der mtl. Dienstbefreiungen für die Jahrestabelle
  '
  Dim Quelle As Range, Ziel As Range, Zeile As Range, Zelle As Range
  Dim IstZeileLeer As Boolean
  
  'Quell- und Zielbereich wie von Dir vorgegeben
  Set Quelle = Range("A35:H48")
  'Suche im Arbeitsblatt 'jahrestabelle' in der Spalte A nach der Zelle mit dem Text 'a) Erkrankte Lehrkräfte'
  Set Ziel = Sheets("jahrestabelle").Range("A:A").Find(What:="a) erkrankte Lehrkräfte", _
             LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
  'Positioniere von dort in der drittnächsten Zelle in Spalte A (unterhalb von 'Name'):
  Set Ziel = Ziel.Offset(3)
    
  For Each Zeile In Quelle.Rows
    'Überprüfe, ob die Quellzeile leer ist
    IstZeileLeer = True
    For Each Zelle In Zeile.Cells
      If Not IsEmpty(Zelle) Then IstZeileLeer = False: Exit For
    Next Zelle
    'Quell-Zeile ist gestestet
    If IstZeileLeer Then
      'Sie ist leer: tue nichts
    Else
      'Sie ist nicht leer: kopiere die Zeile (nur Werte) von der Quelle ins Ziel
      Zeile.Copy
      Ziel.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
      'Stelle Zielzeile 1 Zeile tiefer
      Set Ziel = Ziel.Offset(1)
    End If
  Next Zeile
  'Kopiermodus beenden
  Application.CutCopyMode = False
  
End Sub

 

habe das Makro auf Dienstbefreiung(en) geändert da a) erkrankte Leerkräfte falsch war - stand so noch in der Testdatei.
Makro lautet jetzt so:
Public Sub NichtLeereZeilen_Kopieren()
'
' jahresdienstbefreiung Makro
' Erstellt eine Kopie der mtl. Dienstbefreiungen für die Jahrestabelle
'
Dim Quelle As Range, Ziel As Range, Zeile As Range, Zelle As Range
Dim IstZeileLeer As Boolean

'Quell- und Zielbereich wie vorgegeben
Set Quelle = Range("A35:H48")
'Suche im Arbeitsblatt 'jahrestabelle' in der Spalte A nach der Zelle mit dem Text 'Dienstbefreiung(en)'
Set Ziel = Sheets("jahrestabelle").Range("A:A").Find(What:="Dienstbefreiung(en)", _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
'Positioniere von dort in der drittnächsten Zelle in Spalte A (unterhalb von 'Name'):
Set Ziel = Ziel.Offset(3)

For Each Zeile In Quelle.Rows
'Überprüfe, ob die Quellzeile leer ist
IstZeileLeer = True
For Each Zelle In Zeile.Cells
If Not IsEmpty(Zelle) Then IstZeileLeer = False: Exit For
Next Zelle
'Quell-Zeile ist gestestet
If IstZeileLeer Then
'Sie ist leer: tue nichts
Else
'Sie ist nicht leer: kopiere die Zeile (nur Werte) von der Quelle ins Ziel
Zeile.Copy
Ziel.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
'Stelle Zielzeile 1 Zeile tiefer
Set Ziel = Ziel.Offset(1)
End If
Next Zeile
'Kopiermodus beenden
Application.CutCopyMode = False

End Sub

Nun ist das Ergebnis so, dass er die 1. Zeil nimmt aber er überschreibt beim 2. mal Kopieren die Zeilen wieder sodaß ich immer nur die zwei Datensätze habe - bei zweimaligen Kopieren und übernahme sollten die Datensätze dann zwei mal drinn stehen, stehen jedoch nur einmal drinn.

Nun, möchte mich an dieser Stelle für deine echt tolle Unterstützung bedanken, leider muss ich für heute wieder schluss machen, werde Morgen in der Schule mal das Makro noch mal durchgehen, falls dir noch etwas einfällt - ich kann erst Morgen abends wieder ! :cry:

 

Hallo,

Code:

Public Sub NichtLeereZeilen_Kopieren()
  '
  ' jahresdienstbefreiung Makro
  ' Erstellt eine Kopie der mtl. Dienstbefreiungen für die Jahrestabelle
  '
  Dim Quelle As Range, Ziel As Range, Zeile As Range, Zelle As Range
  Dim IstZeileLeer As Boolean
  
  'Quell- und Zielbereich wie von Dir vorgegeben
  Set Quelle = Range("A35:H48")
  'Suche im Arbeitsblatt 'jahrestabelle' in der Spalte A nach der Zelle mit dem Text 'a) Erkrankte Lehrkräfte'
  Set Ziel = Sheets("jahrestabelle").Range("A:A").Find(What:="a) erkrankte Lehrkräfte", _
             LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
  'Positioniere von dort in der drittnächsten Zelle in Spalte A (unterhalb von 'Name'):
  Set Ziel = Ziel.Offset(3)
  'Durchlaufe die folgende Schleife, bis eine leere Zelle in Spalte gefunden wurde
  Do Until Ziel.Value = ""
    Set Ziel = Ziel.Offset(1)
  Loop
    
  For Each Zeile In Quelle.Rows
    'Überprüfe, ob die Quellzeile leer ist
    IstZeileLeer = True
    For Each Zelle In Zeile.Cells
      If Not IsEmpty(Zelle) Then IstZeileLeer = False: Exit For
    Next Zelle
    'Quell-Zeile ist gestestet
    If IstZeileLeer Then
      'Sie ist leer: tue nichts
    Else
      'Sie ist nicht leer: kopiere die Zeile (nur Werte) von der Quelle ins Ziel
      Zeile.Copy
      Ziel.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
      'Stelle Zielzeile 1 Zeile tiefer
      Set Ziel = Ziel.Offset(1)
    End If
  Next Zeile
  'Kopiermodus beenden
  Application.CutCopyMode = False
  
End Sub

Im obigen Programm habe im Vergleich zur Vorgängerversion Folgendes eingefügt:

Code:

  'Durchlaufe die folgende Schleife, bis eine leere Zelle in Spalte gefunden wurde
  Do Until Ziel.Value = ""
    Set Ziel = Ziel.Offset(1)
  Loop

Damit sucht Excel nach der 1. freien Zelle (=Zelle, in der kein Wert, also weder Zahl noch Text, steht) in Spalte A unterhalb von 'Name'.

 

Hallo exl121150,

da kann man mal sehen, was zwei Zeilen alles ausmachen können, du bist einfach Super. Woher weisst du das alles? auswendig - mit Buch - Training, auf alle Fälle beneide ich dich darum und will mich auch für deine Hilfe bedanken :mrgreen:

Jetzt funktioniert es genau wie es sein soll, so jetz brauch ich noch ein Makro das danach gestartet wird über sep. Button der mir die zuvor eingegebenen Daten in der Tabelle 2 in den Bereichen E2:G20 und E25:G43 löscht. Mal sehen vielleicht schaffe ich das, wenn nicht schau ich noch mal hier nach ob da ein guter Geist so etwas gemacht hat :roll: .

Auf alle Fälle, kann ich dich und dieses Forum nur weiter empfehlen und so langsam komme ich wieder auf dem Geschmack um mal wieder öfters was in Excel zu machen.

Ich wünsche Dir und allen anderen hier im Forum noch einen schönen Tag und macht weiter so.