Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1368to1372
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
Inhaltsverzeichnis

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

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

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige