Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
744to748
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
744to748
744to748
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

makro anpassen

makro anpassen
18.03.2006 08:05:19
mehmet
hallo forum
ich kann leider folgendes makro nicht anpassen
Option Explicit

Sub UmKopieren()
Dim i&, j&, src As Worksheet
Set src = Worksheets("Tabelle1")
Worksheets.Add(after:=src).Name = "tab2"
j = 2
With src
For i = 2 To .Cells(.Rows.Count, 10).End(xlUp).Row
If .Cells(i, 5).Value Like "*Summe" Then
.Range(.Cells(i, 1), .Cells(i, 10)).Copy Cells(j, 1) 'hier aber wo?
j = j + 1
End If
Next
End With
End Sub

es wird von tabelle1 die zeile kopiert und in tab2 eingefuegt
wenn in spalte e "summe" steht.
leider ist in tabelle1 spalte j ein formel
wenn ich jetzt tab2 nachsehe, bekomme eine fehlermeldung
wie kann man die spalte j als "value" in tab2 einfuegen statt formel mit bezug?
dank und gruss
mehmet

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: makro anpassen
18.03.2006 09:28:24
Beate
Hallo Mehmet,
2 Alternativen:
Sub UmKopieren() 'dieses kopiert Formate mit
    Dim i&, j&, src As Worksheet
    Application.ScreenUpdating = False
    Set src = Worksheets("Tabelle1")
    Worksheets.Add(after:=src).Name = "Tab2"
    j = 2
    With src
        For i = 2 To .Cells(.Rows.Count, 10).End(xlUp).Row
            If .Cells(i, 5).Value Like "*Summe" Then
                .Range(.Cells(i, 1), .Cells(i, 10)).Copy Cells(j, 1) 'hier aber wo?
                j = j + 1
            End If
        Next
    End With
    Columns("A:J").Copy
    Columns("A:J").PasteSpecial Paste:=xlPasteValues
    Application.ScreenUpdating = True
End Sub


Sub UmKopieren2() 'dieses kopiert nur Werte
    Dim i&, j&, src As Worksheet
    Application.ScreenUpdating = False
    Set src = Worksheets("Tabelle1")
    Worksheets.Add(after:=src).Name = "Tab2"
    j = 2
    With src
        For i = 2 To .Cells(.Rows.Count, 10).End(xlUp).Row
            If .Cells(i, 5).Value Like "*Summe" Then
                .Range(.Cells(i, 1), .Cells(i, 10)).Copy
                Cells(j, 1).PasteSpecial Paste:=xlPasteValues
                j = j + 1
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub
Gruß,
Beate
Anzeige
AW: makro anpassen
18.03.2006 09:51:57
mehmet
super beate
herzlichen dank
kann man dies auch ohne makro realisieren?
https://www.herber.de/bbs/user/32001.xls
(makro ist kommentiert & inaktiv)
gruss
mehmet
AW: Erklärung zu Gruppierung und Gliederung
18.03.2006 11:24:46
mehmet
super beate dank dir
kann man den folgenden code mit zwei eingabe aufforderung bestuecken:
Option Explicit

Sub UmKopieren()
Dim i&, j&, src As Worksheet
Set src = Worksheets("Tabelle1")
Worksheets.Add(after:=src).Name = "Tab2"
j = 2
With src
For i = 2 To .Cells(.Rows.Count, 10).End(xlUp).Row 'welche spalte, hier j
If .Cells(i, 5).Value Like "*Summe" Then        'welches kriterium, hier summe
.Range(.Cells(i, 1), .Cells(i, 10)).Copy
Cells(j, 1).PasteSpecial Paste:=xlPasteValues
j = j + 1
End If
Next
End With
Range("A1").Select
Sheets("Tabelle1").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub

in kommentierter zeile (welche spalte, hier j) wuerde ich gern ein eingabe aufforderung einarbeiten und
in kommentierter zeile (welches kriterium, hier summe) wuerde ich gern auch eingabe aufforderung einarbeiten
dank im voaus fuer deine hilfe
herzliche gruss
mehmet
Anzeige
AW: Erklärung zu Gruppierung und Gliederung
18.03.2006 11:52:22
Beate
Hallo Mehmet,
jetzt muss ich dich erstmal zeitlich vertrösten, da ich weg muss. Wenn sich sonst niemand einschaltet schaue ich bis morgen nochmal rein.
Gruß,
Beate
dank dir, ok 8-) o.T.
18.03.2006 12:11:11
mehmet
.
AW: Erklärung zu Gruppierung und Gliederung
18.03.2006 13:51:41
Ramses
Hallo
probier mal
Sub UmKopieren()
    Dim i As Long, j As Long, Qe As Long
    Dim src As Worksheet, srcCol As Range, srcString As String
    Dim foundSheet As Boolean
    j = 2
    foundSheet = False
    On Error Resume Next
    Set src = Worksheets("Tabelle2")
    Set srcCol = Application.InputBox("Welche Spalte soll durchsucht werden?", _
        "Suchspalte definieren", "", Type:=8)
    If srcCol Is Nothing Then
        MsgBox "Keine Spalte gewählt", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    srcString = InputBox("Welcher Begriff soll gesucht werden?", "Suchbegriff", "Summe")
    If srcString = "" Then
        MsgBox "Kein Begriff definiert", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Kopie_" & src.Name Then
            Qe = MsgBox("Die Tabelle existiert schon. Sollen die Daten gelöscht werden ?", _
                vbCritical + vbYesNo, "Datenfehler")
            If Qe = vbNo Then
                MsgBox "Zuerst die Tabellenstruktur bereinigen", vbCritical + vbOKOnly, "Abbruch"
                Exit Sub
            Else
                src.Cells.Clear
                Exit For
            End If
            foundSheet = True
        End If
    Next i
    If foundSheet = False Then
        Worksheets.Add(after:=src).Name = "Kopie_" & src.Name
    End If
    On Error GoTo 0
    Debug.Print srcCol.Column
    With src
        For i = 2 To .Cells(.Rows.Count, srcCol.Column).End(xlUp).Row
            If .Cells(i, srcCol.Column).Value Like "*" & srcString Then
                .Range(.Cells(i, 1), .Cells(i, 10)).Copy
                Cells(j, 1).PasteSpecial Paste:=xlPasteValues
                j = j + 1
            End If
        Next
    End With
    With src
        .Select
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End Sub
Gruss Rainer
Anzeige
ACHTUNG: Korrektur
18.03.2006 14:11:37
Ramses
Hallo
du musst diesen Code nehmen, mit dem oberen Code können u.U. die Ausgangsdaten gelöscht werden.
Sub UmKopieren()
    Dim i As Long, j As Long, Qe As Long
    Dim src As Worksheet, srcCol As Range, srcString As String
    Dim foundSheet As Boolean
    j = 2
    foundSheet = False
    On Error Resume Next
    Set src = Worksheets("Tabelle2")
    Set srcCol = Application.InputBox("Welche Spalte soll durchsucht werden?", _
        "Suchspalte definieren", "$C:$C", Type:=8)
    If srcCol Is Nothing Then
        MsgBox "Keine Spalte gewählt", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    srcString = InputBox("Welcher Begriff soll gesucht werden?", "Suchbegriff", "Summe")
    If srcString = "" Then
        MsgBox "Kein Begriff definiert", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Kopie_" & src.Name Then
            Qe = MsgBox("Die Tabelle existiert schon. Sollen die Daten gelöscht werden ?", _
                vbCritical + vbYesNo, "Datenfehler")
            If Qe = vbNo Then
                MsgBox "Zuerst die Tabellenstruktur bereinigen", vbCritical + vbOKOnly, "Abbruch"
                Exit Sub
            Else
                Worksheets("Kopie_" & src.Name).Cells.Clear
                Exit For
            End If
            foundSheet = True
        End If
    Next i
    If foundSheet = False Then
        Worksheets.Add(after:=src).Name = "Kopie_" & src.Name
    End If
    On Error GoTo 0
    Debug.Print srcCol.Column
    With src
        For i = 2 To .Cells(.Rows.Count, srcCol.Column).End(xlUp).Row
            If .Cells(i, srcCol.Column).Value Like "*" & srcString Then
                .Range(.Cells(i, 1), .Cells(i, 10)).Copy
                Cells(j, 1).PasteSpecial Paste:=xlPasteValues
                j = j + 1
            End If
        Next
    End With
    With src
        .Select
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End Sub
Gruss Rainer
Anzeige
per Input Box ausgewählt kopieren
18.03.2006 16:27:01
Beate
Hallo Rainer,
danke, dass du dich eingeschaltet hast. Deine Lösung läuft bei mir.
Aber wäre es nicht einfacher, das "Kopie"-Blatt zu löschen, falls vorhanden und neu zu erstellen?
Datei anbei: https://www.herber.de/bbs/user/32008.xls
Sub Umkopieren3()
    Dim i As Long, j As Long, Qe As Long
    Dim src As Worksheet, srcCol As Range, srcString As String
    Dim foundSheet As Boolean
    j = 2
    foundSheet = False
    On Error Resume Next
    Set src = Worksheets("Tabelle2")
    Set srcCol = Application.InputBox("Welche Spalte soll durchsucht werden?", _
        "Suchspalte definieren", "$E:$E", Type:=8)
    If srcCol Is Nothing Then
        MsgBox "Keine Spalte gewählt", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    srcString = InputBox("Welcher Begriff soll gesucht werden?", "Suchbegriff", "Summe")
    If srcString = "" Then
        MsgBox "Kein Begriff definiert", vbCritical + vbOKOnly, "Abbruch"
        Exit Sub
    End If
    Application.DisplayAlerts = False
    Sheets("Kopie").Delete
    Application.DisplayAlerts = True
    Worksheets.Add(after:=src).Name = "Kopie"
    On Error GoTo 0
    Debug.Print srcCol.Column
    With src
        For i = 2 To .Cells(.Rows.Count, srcCol.Column).End(xlUp).Row
            If .Cells(i, srcCol.Column).Value Like "*" & srcString Then
                .Range(.Cells(i, 1), .Cells(i, 10)).Copy
                Cells(j, 1).PasteSpecial Paste:=xlPasteValues
                j = j + 1
            End If
        Next
    End With
    With src
        .Select
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End Sub
Gruß,
Beate
Anzeige
es läuft, dank dir beate, gruss. o.T.
18.03.2006 16:30:59
mehmet
.
AW: per Input Box ausgewählt kopieren
18.03.2006 17:01:36
Ramses
Hallo Beate
Ich weiss ja nicht, ob der die Daten vielleicht noch behalten will ?
War nur eine Variante.
Gruss Rainer
danke ramses, gruss o.T.
18.03.2006 16:27:18
mehmet
.

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige