Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
892to896
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
892to896
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Wertkopie in neue Arbeitsmappe

Wertkopie in neue Arbeitsmappe
08.08.2007 09:44:00
Peter
Guten Morgen.
Ich versuche meine Frage bzw. Anforderung noch einmal neu zu beschreiben. Gestern hatte ich leider keinen Erfolg.
Also gegeben ist eine umfangreiche Tabelle (dort sind diverse Formeln etc. hinterlegt und es werden Daten aus einer Datenbank ausgelesen). Per Makro soll von dieser Tabelle eine Kopie (Werte und Formate) erstellt werden in eine neue Arbeitsmappe. Soweit der 1. Teil.
Im 2. Teill sollten dann ebenfalls per Makro "überflüssige Zeilen" gelöscht werden. Es kann Zeilen geben, in denen im Spaltenbereich L bis AD komplett 0-Werte sind. Sollte dies der Fall sein, sollen diese Zeilen komplett gelöscht werden.
Vielen Dank für eure Hilfe!
Peter

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wertkopie in neue Arbeitsmappe
08.08.2007 10:03:00
Ramses
Hallo
probier mal
Option Explicit

Sub test()
    Dim i As Long, lastRow As Long
    ActiveSheet.Copy
    With ActiveSheet
        .Select
        With Selection
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
    End With
    lastRow = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.Sum(Range("L" & i & ":AD" & i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
End Sub

Gruss Rainer

Anzeige
AW: Wertkopie in neue Arbeitsmappe
08.08.2007 10:13:09
Peter
Hallo Rainer.
Das sieht schon recht gut aus. Allerdings sind in den Zellen des Datenbereichs dann weiterhin die Formeln und Bezüge. Hier dürfen nur noch die Werte (Wertkopie) stehen (da die Datei von Usern genutzt werden soll, die keinen Zugriff auf die Datenbank haben).
Zudem noch drei weitere Fragen...:
1.) Das Löschen der Zeilen bitte erst ab Zeile 19
2.) Kann gleich ein Speicherort und ein Speichername (z.B. Auswertung) festgelegt werden beim Erstellen der neuen Arbeitsmappe?
Danke!

AW: Wertkopie in neue Arbeitsmappe
08.08.2007 10:18:53
Ramses
Hallo
Sorry, der Code war ungetestet, daher noch ein kleiner Gedankenfehler drin :-)
Option Explicit

Sub test()
    Dim i As Long, lastRow As Long
    ActiveSheet.Copy
    With ActiveSheet
        .Cells.Select
        With Selection
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
        Application.CutCopyMode = False
        .Cells(1, 1).Select
    End With
    lastRow = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
    For i = lastRow To 19 Step -1
        If Application.WorksheetFunction.Sum(Range("L" & i & ":AD" & i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
    ActiveWorkbook.SaveAs "C:\DeineAuswertung.xls"
End Sub

Gruss Rainer

Anzeige
AW: Wertkopie in neue Arbeitsmappe
08.08.2007 10:28:06
Peter
Hallo Rainer!
Super. Haut alles hin. So habe ich mir das vorgestellt. Eine kleine Frage habe ich aber noch (schäm)... könnte man diesen Speicherort/Namen quasi nur als Vorschlag nehmen - der Speichern unter Modus öffnet sich und bietet dies an und bestätigt es oder wählt den individuell gewünschten aus. Danke!

AW: Wertkopie in neue Arbeitsmappe
08.08.2007 12:06:00
Ramses
Hallo
Option Explicit


Sub test()
    Dim i As Long, lastRow As Long
    Dim saveName As String
    ActiveSheet.Copy
    With ActiveSheet
        .Cells.Select
        With Selection
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
        Application.CutCopyMode = False
        .Cells(1, 1).Select
    End With
    lastRow = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
    For i = lastRow To 19 Step -1
        If Application.WorksheetFunction.Sum(Range("L" & i & ":AD" & i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
    saveName = Application.GetSaveAsFilename(fileFilter:="EXCEL Files (*.xls), *.xls")
    Debug.Print saveName
    If StrPtr(saveName) <> 0 Then
        ActiveWorkbook.SaveAs saveName
    Else
        MsgBox "Datei wird nicht gespeichert"
    End If
End Sub

Gruss Rainer

Anzeige
AW: Wertkopie in neue Arbeitsmappe
08.08.2007 12:53:00
Peter
Super! Pertfekt gelöst! Ich dank dir!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige