Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Wenn Zeile n. leer, kopiere in neues Arbeitsblatt

Wenn Zeile n. leer, kopiere in neues Arbeitsblatt
01.07.2014 15:01:41
Cédric
Hallo Liebe Rettungsanker:
Folgender Hintergrund
Tabelle 1 eine Grunddatentabelle mit gesperrten Zellen, Daten sind ab Zeile 6 vorhanden.
Wenn in der Spalte B ein Kommentar eingetragen ist (=nicht leer") dann soll es diese Zeile in ein anderes Tabellenblatt kopieren und dieses unter neuem Namen abspeichern.
Hier mein Versuch:
[Vielen Dank für die Hilfe]
Sub Revisionsblätter()
' Revisionsblätter Makro
Sheets("Tabelle1").Select
K = WorksheetFunction.CountA(Range("BB:BB"))
H = WorksheetFunction.Count(Range("BB:BB"))
Dim j As Long
Sheets("Tabelle1").Select
Range("BB6").Select
For j = 1 To H
If ActiveCell.Value = "" Then ActiveCell.Offset(1, 0).Select Else EntireColumn.Copy
Sheets("Bericht für Revision").Select
Range("1:1").Select
Active.Range.Paste
ActiveSheet.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = ActiveSheet.Range("A1")
Sheets("Tabelle1").Select
Range("BB6").Select
ActiveCell.Offset(j, 0).Select
Next j
End Sub

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wenn Zeile n. leer, kopiere in neues Arbeitsblatt
02.07.2014 14:23:58
fcs
Hallo Cédric,
in folgender Form sollte es funktionieren.
Die vielen Select- und Activecell....-Anweisungen sind dann sicht erforderlich.
Gruß
Franz
Sub Revisionsblätter()
' Revisionsblätter Makro
Dim wksTab1 As Worksheet
Dim wksRev As Worksheet
Dim wksNeu As Worksheet
Dim Zeile As Long, K As Long, H As Long, Spalte As Long
Set wksTab1 = ActiveWorkbook.Sheets("Tabelle1")
Set wksRev = ActiveWorkbook.Sheets("Bericht für Revision")
Application.ScreenUpdating = False
With wksTab1
Zeile_1 = 6  '1. Datenzeile
Spalte = .Range("BB6").Column 'Spalte in der auf  "" geprüft werden soll
Zeile_L = .Cells(.Rows.Count, Spalte).End(xlUp).Row 'letzte Zeile mit Inhalt in Prüfspalte
For Zeile = Zeile_1 To Zeile_L
If .Cells(Zeile, Spalte).Value  "" Then
With ActiveWorkbook
wksRev.Copy After:=.Sheets(.Sheets.Count)
Set wksNeu = ActiveSheet
End With
.Rows(Zeile).Copy Destination:=wksNeu.Rows(1)
wksNeu.Name = wksNeu.Range("A1").Text
End If
Next Zeile
End With
Application.ScreenUpdating = True
End Sub

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige