Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.05.2024 11:39:18
VBA Select Case i.V. mit vbNullString
29.05.2024 11:31:30
Verbindung zu Oracle, Datensätze fehlen
29.05.2024 10:58:12
Datumsvergleich mit Excel
29.05.2024 10:07:32
Verknüpfte Dateien (mit Makros) erkennen Quelle nicht immer?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren in Leere Zeilen

Kopieren in Leere Zeilen
31.01.2023 15:24:35
Heiko
Moin.
ich möchte wohl gerne das aus dem Arbeitsblatt "gesägte Rohre" die angegebenen Zellen in das Arbeitsblatt "Tagesnachweis"
Dabei soll aber kontrolliert werden ob sich im Arbeitsblatt "Tagesnachweis" in den Zellen A7:A25 Daten sind. Falls ja, soll die nächste Zelle kontrolliert werden, bis eine Leer ist. Dann die Daten dorthin kopieren.
Sub Rohr_13_378()
Sub Rohr_13_378()
'
' Rohr_13_378 Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
    Range("C4:E4").Select
    Range("E4").Activate
    Selection.Copy
    Sheets("Tagesnachweis").Select
    Range("A7").Select
    ActiveSheet.Paste
    Range("A7:C7").Select
    Range("C7").Activate
    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Sheets("gesägte Rohre").Select
    ActiveWorkbook.Save
    
    
   
End Sub
    
    
   
End Sub

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren in Leere Zeilen
31.01.2023 15:46:57
UweD
Hallo
so?

Sub Rohr_13_378()
'
' Rohr_13_378 Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("C4:E4")
    
    With Sheets("Tagesnachweis")
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
        LR = Application.Max(7, LR) 'ab Zeile 7 beginnend
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
    
    
   
End Sub

LG UweD
Anzeige
AW: Kopieren in Leere Zeilen
31.01.2023 15:57:00
ChrisL
Hi
Etwas gekürzt unter Voraussetzung:
- wenn du nur die Werte ohne Formate kopieren möchtest, dann brauchst du die Formatierung nicht zurücksetzen (Inhalte einfügen, Werte)
- Wenn in A6 (z.B. Titel) oder folgende schon etwas steht, brauchst die Abfrage für Minimum-Zeile 7 nicht
    Worksheets("gesägte Rohre").Range("C4:E4").Copy
    Worksheets("Tagesnachweis").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    ThisWorkbook.Save
cu
Chris
AW: Nachfrage
31.01.2023 16:14:32
GerdL
Hallo,
ist nur in Spalte A zu prüfen oder müssen "quer" auch die Zellen in den Spalten B und C, also drei Zellen nebeneinander leer sein?
Gruß Gerd
Anzeige
AW: Kopieren in Leere Zeilen
31.01.2023 16:58:33
Heiko
Moin
Danke für die Antworten..
Ich kann es erst morgen probieren
@GerdL es muss nur A abgefragt werden. Alles andere wird vorher automatisch. gelöscht
Gruß Heiko
AW: Kopieren in Leere Zeilen
01.02.2023 09:20:33
Heiko
moin,
habe jetzt mal beide Antworten ausgeführt.
Leider werden die Daten jetzt ganz unten, unter der Tabelle eingefügt.
Das Formular geht von A1:H30
Ab a31 werden die Daten aber erst eingefügt. Und nicht in der Tabelle ab A7.

Sub Rohr_13_378()
'
' Rohr_13_378 Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
 Worksheets("gesägte Rohre").Range("C4:E4").Copy
     Worksheets("Tagesnachweis").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
     Application.CutCopyMode = False
     ThisWorkbook.Save
     
 '   Range("C4:E4").Select
  '  Range("E4").Activate
   ' Selection.Copy
    'Sheets("Tagesnachweis").Select
 '   Range("A7").Select
 '   ActiveSheet.Paste
 '   Range("A7:C7").Select
 '   Range("C7").Activate
 '   Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 11
       .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Sheets("gesägte Rohre").Select
    ActiveWorkbook.Save
    
    
   
End Sub
Sub Rohr_13_340()
'
' Rohr_13_340 Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("C5:E5")
    
    With Sheets("Tagesnachweis")
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
        LR = Application.Max(7, LR) 'ab Zeile 7 beginnend
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
    
    
   
End Sub

Anzeige
AW: Kopieren in Leere Zeilen
01.02.2023 10:03:53
ChrisL
Hi
Bitte eine Beispieldatei ins Forum laden. Gerne als xlsx (ohne Makros).
cu
Chris
AW: Kopieren in Leere Zeilen
01.02.2023 10:41:43
UweD
Hallo
es soll also die erste Freie Zeile im Bereich A7:A25 finden.
dann ermittle LR wie folgt
        LR = Evaluate("=MIN(IF(A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
LG UweD
AW: Kopieren in Leere Zeilen
01.02.2023 12:58:33
UweD
Du solltest in dem Makro von mir die Ermittlung von LR austauschen.
hier nochmal komplett

Sub Rohr_13_340()
'
' Rohr_13_340 Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("C5:E5")
    
    With Sheets("Tagesnachweis")
        LR = Evaluate("=MIN(IF(A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
    
 End Sub
LG UweD
Anzeige
Korrektur
01.02.2023 13:08:16
UweD
Hallo nochmal
da du das Makro vom 2. Blatt aus aufrufst, hier noch eine Ergänzung

Sub Rohr_13_340()
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("a5:c5")
    
    With Sheets("Tagesnachweis")
        LR = Evaluate("=MIN(IF(Tagesnachweis!A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
      
End Sub
LG UweD
Anzeige
Korrektur 2
01.02.2023 13:26:09
UweD 

Sub Rohr_13_340()
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("a5:c5")
    
    With Sheets("Tagesnachweis")
        LR = Evaluate("=MIN(IF(Tagesnachweis!A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
        Set RNGZ = .Cells(LR, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
        End With
    End With
    ActiveWorkbook.Save
End Sub
Sub Tagesnachweis_bereinigen()
'
' Tagesnachweis_bereinigen Makro
' Bereinigt die Tabelleneingaben
'
'
    Sheets("Tagesnachweis").Range("A7:F25").ClearContents
End Sub

Anzeige
AW: Korrektur 2
01.02.2023 15:41:13
Heiko
moin
danke erst einmal....Doch leider werden die Zeilen immer überschrieben.
Wenn ich ein weiteres Rohr einfügen möchte, schreibt Excel die Daten immer in die Zeile wo ich gerade das erste Maß eingegeben habe....
Also wenn ich in Zelle A8 die Maße 378 eingefügt habe, und dann das Maß 340 einfüge, verschwindet das 378 Maß

Sub Rohr_13_378()
'
' Rohr_13_378Makro
'
'das ist das Arbeitsblatt "gesägte Rohre" hier sollen die Zellen kopiert werden
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("C4:E4")
    
    With Sheets("Tagesnachweis")
         
         LR = Evaluate("=MIN(IF(Tagesnachweis!A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
               ' LR = Application.Max(7, LR) 'ab Zeile 7 beginnend
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
    
    
   
End Sub
Sub Rohr_13_340()
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("c5:e5")
    
    With Sheets("Tagesnachweis")
        LR = Evaluate("=MIN(IF(Tagesnachweis!A7:A25="""",ROW(7:25)))") 'Erste Lücke in Spalte
        Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)
        
        RNGQ.Copy RNGZ
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
      
End Sub

Anzeige
AW: Korrektur 2
01.02.2023 16:02:25
UweD
Dann hast du die letzte Korrektur2 noch nicht eingebaut.
Set RNGZ = .Cells(LR, 1).Resize(1, 3)

anstelle von 
Set RNGZ = .Cells(LR + 1, 1).Resize(1, 3)

AW: Korrektur 2
02.02.2023 07:27:36
Heiko
Moin.
Danke für die Hilfe
Zur Zeit läuft es.
Danke Heiko
AW: Korrektur 2
02.02.2023 15:25:12
Heiko
moin
ich noch einmal.....mit folgenden Fehler nach Neustart von Excel......
Laufzeitfehler 1004 bei RNGQ.Copy RNGZ
Sub Rohr_13_701()
'
' Rohr_13_701Makro
'
    Dim RNGQ As Range, RNGZ As Range, LR As Long
    Set RNGQ = Sheets("gesägte Rohre").Range("C12:E12")
    
    With Sheets("Tagesnachweis")
         
         LR = Evaluate("=MIN(IF(Tagesnachweis!A7:A25="""",ROW(7:25)))")
               LR = Application.Max(7, LR) 'ab Zeile 7 beginnend
        Set RNGZ = .Cells(LR, 1).Resize(1, 3)
        
       RNGQ.Copy RNGZ   'hier ist der Fehler......bei jeden Rohr..!!!!!!!   Laufzeitfehler.1004..!Dies ist bei verbundenen Zellen nicht möglich!!
        
        With RNGZ.Font
            .Name = "Arial"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    ActiveWorkbook.Save
    
    
   
End Sub

Anzeige
AW: Korrektur 2
02.02.2023 16:51:28
UweD
Hallo
verbundene Zellen ist immer ein Problem.
Lade nochmal eine Datei hoch, wo der Fehler auftritt.
LG UweD
AW: Korrektur 2
03.02.2023 08:53:41
Heiko
hallo,
so, habe den Fehler selber gefunden...
Wie es aussieht, habe ich wohl beim kopieren oder sonstiges zwei Zellen verbunden.....
Habe die wieder getrennt und siehe da, es läuft.
Hoffe das es so bleibt.
Super vielen Dank erst einmal......
Gruß Heiko
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige