Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Copy wenn A und nicht ganzes Tabellenblatt

    Betrifft: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 10:14:33

    Hi Leute,
    Mit Hilfe von Beni hab ich gestern diesen Code zusammen gebaut

    Private Sub CommandButton1_Click()
    Dim sPath As String, sWks As String, sFile As String
    Application.ScreenUpdating = False
    sPath = ActiveWorkbook.Path & "\"
    Dim Default
    sWks = "Berechnungen"
    If sWks = "" Then Exit Sub
    sFile = [a2] & "-" & [f2] & "-" & [i2]
        prompt = "Blattname"
    If sFile = "" Then Exit Sub
    ActiveSheet.Copy
    ActiveSheet.Name = sWks
    ActiveWorkbook.SaveAs sPath & sFile
    ActiveSheet.Shapes("CommandButton1").Delete
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    End Sub
    


    um ein neues Workbook anzulegen und das eine Tabellenblatt da hinein zu kopieren.
    Aber es sollte nicht das ganze Tabebelle kopieren, sondern nur die Row wenn bedingung erfüllt. Hab das über ne Schleife und ein If versucht und dem Copy noch ein Range vorgeschaltet,aber irgendwie will er das dann nicht ganz kopieren. Und wenn es geht,sollte er die "wenn ja erfüllt" Zeilen auch unternander kopieren und nicht genau in die selbe Zeile wie aus dem Orginal, d.h. untereinander,selbst wenn die nächste zeile mit dem Atribut erst 20 Zeilen später im Orginal kommt.

    Fragen über fragen,ich weiß. aber helfen kann mir da doch bestimmt einer oder?

    Gruß Sven
      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Beni
    Geschrieben am: 01.10.2003 11:43:14

    Hallo Sven,
    das geht schon, ich würde die Daten in eine temporäre Tabelle kopieren und dann die temporäre Tabelle in eine neue Arbeitsmappe kopieren.
    Wenn Du ein Beispiel zur Verfügung stellst und beschreibst, was kommt wohin, dann kriegen wir das schon hien.
    Gruss Beni


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 11:49:41

    Also, in der Tabelle dich ich bisher einfach nur kopiert habe, sollen nun nur bestimmt Datensäze herraus kopiert werden.
    Also:
    For b = 18 to 1000
    If ActiveSheets.Range("g" & b) <> n;v;a; oder s Then
    Copy in das angelegte Worksheet, aber hintereinander.
    end if
    next
    Ist das das Beispiel das du meintest?


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Marc
    Geschrieben am: 01.10.2003 11:47:09

    Hallo Sven,

    was für Bedingungen sollen denn abgefragt werden?
    Sind doch keine im Code enthalten.

    ActiveSheet.Copy kopiert das ganze Blatt, gnadenlos...

    Die beiden If-Abfragen kannste Dir schenken, da beide Variablen unmittelbar vorher so initialisiert werden, dass sie nie leer sein können.

    Auch die Initialisierung von sFile macht keinen Sinn, was willst Du damit erreichen ?

    Ebenfalls Fragen über Fragen :-)
    Grüsse,

    Marc


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 12:31:39

    Also, in der Tabelle dich ich bisher einfach nur kopiert habe, sollen nun nur bestimmt Datensäze herraus kopiert werden.
    Also:
    For b = 18 to 1000
    If ActiveSheets.Range("g" & b) <> n;v;a; oder s Then
    Copy in das angelegte Worksheet, aber hintereinander.
    end if
    next
    Ist das das Beispiel das du meintest?


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Marc
    Geschrieben am: 01.10.2003 13:20:11

    Hallo Sven,

    probier doch mal folgendes:

    Private Sub CommandButton1_Click()
    Dim sPath, sWks, sFile As String
    Dim b, i
    Dim zellinhalt
    
     Application.ScreenUpdating = False
     sPath = ActiveWorkbook.Path & "\"
     sWks = "Berechnungen"
    
     sFile = [A2].Value & "-" & [F2].Value & "-" & [I2].Value & ".xls"
     '  Diese Zuweisung des Dateinamens ergibt für mich so wenig Sinn, aber wenn Du's so brauchst...
    
     ActiveSheet.Copy
     ActiveSheet.Name = sWks
     ActiveWorkbook.SaveAs Filename:=sPath & sFile
     ActiveSheet.Cells.Select
     Selection.ClearContents
     i = 1
     For b = 18 To 1000
      zellinhalt = ThisWorkbook.ActiveSheet.Range("G" & b).Value
       Select Case zellinhalt
        Case "n", "v", "a", "s"
        i = i + 1
        ThisWorkbook.ActiveSheet.Rows(b & ":" & b).EntireRow.Copy
        Workbooks(sFile).Sheets(sWks).Range("A" & i).Select
        ActiveSheet.Paste
       End Select
      Next b
     ActiveSheet.Shapes("CommandButton1").Delete
     ActiveWorkbook.Close
     Application.ScreenUpdating = True
    End Sub
    


    Grüsse,
    Marc


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 13:49:27

    Danke Marc für die Hilfe,funktionier auch wunderbar.
    Nun habe ich aber ein neues Problem. Denn es werden auch formel mitkopiert, in denen die Bezüge nicht mehr stimmen nach dam kopieren. das 2. Problem dabei ist,das ich die Formeln nicht variabler machen kann, das sie aus dem VBA her in die Zelle geschrieben werden und ich da nicht weiß wie ich angeben kann die zelle sich Variabl verhält (Wir normal,wenn wem celle kopiert,passt sich der Code an).
    Oder muß ich einfach nur diesen Code verändern um die Sache variabel zu machen?

    Worksheets("Berechnungen").Range("h" & Count) = "=R" & Count & "C9/R" & Count & "C3"


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Marc
    Geschrieben am: 01.10.2003 14:03:12

    Hi Sven,

    sollen die Formeln mitkopiert werden ?
    Sind die Zellen C3 und C9 in der neuen Datei dann auch vorhanden ?
    Oder nur die Werte kopieren ?
    Dann die Zeile
    ActiveSheet.Paste durch
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

    ersetzen.

    Grüsse,
    Marc


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 14:15:50

    Die cellbezüge in der Formel beziehen sich ja auch auf die gleiche Row. Und da die ganz row kopiert wird, bleiben die Formel an sich gleich. Nur,wenn die Formal nach dem Copy in Row 9 steht, steht immernoch die Uhrsprungsrow darin,ausdem die Zeile kopiert wurde.

    Ach und wenn wir gerade dabei sind,eine sortierung hätten die auchnoch gern, nach n,v,a,und s.
    Die erwarten sachen von mir,das gibts nicht. Bin ich Programmierer *heul*
    Kannste mir da vielleicht auch helfen?


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Marc
    Geschrieben am: 01.10.2003 14:45:15

    Hallo Sven,

    dann probier mal das hier:
    Ich habe die geänderten Zeilen mal fett gemacht:

    Private Sub CommandButton1_Click()
    Dim sPath, sWks, sFile As String
    Dim b, i
    Dim zellinhalt
    
     Application.ScreenUpdating = False
     sPath = ActiveWorkbook.Path & "\"
     sWks = "Berechnungen"
    
     sFile = [A2].Value & "-" & [F2].Value & "-" & [I2].Value & ".xls"
     '  Diese Zuweisung des Dateinamens ergibt für mich so wenig Sinn, aber wenn Du's so brauchst...
    
     ActiveSheet.Copy
     ActiveSheet.Name = sWks
     ActiveWorkbook.SaveAs Filename:=sPath & sFile
     ActiveSheet.Cells.Select
     Selection.ClearContents
     i = 17
     For b = 18 To 1000
      zellinhalt = ThisWorkbook.ActiveSheet.Range("G" & b).Value
       Select Case zellinhalt
        Case "n", "v", "a", "s"
        i = i + 1
        ThisWorkbook.ActiveSheet.Rows(b & ":" & b).EntireRow.Copy
        Workbooks(sFile).Sheets(sWks).Range("A" & i).Select
        ActiveSheet.Paste
        Workbooks(sFile).Sheets(sWks).Range("H" & i).FormulaR1C1 =  "=R" & i & "C9/R" & i & "C3"
       End Select
      Next b
      Range("A18:L1000").Select
       Range("A18").Activate
       Selection.Sort Key1:=Range("G18"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     ActiveSheet.Shapes("CommandButton1").Delete
     ActiveWorkbook.Close
     Application.ScreenUpdating = True
    End Sub
    



    Viel Erfolg,
    Marc


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 15:12:19

    Also ich hab den Code dann doch entsprechend den anforderungen geändertAber er bring mir fehlermeldung:
    Private Sub CommandButton1_Click()
    Dim sPath, sWks, sFile As String
    Dim b, i
    Dim zellinhalt
    
    Application.ScreenUpdating = False
    sPath = ActiveWorkbook.Path & "\"
    sWks = "Berechnungen"
    
    sFile = [F2].Value & " - " & [I2].Value & ".xls"
     
    ActiveSheet.Copy
    ActiveSheet.Name = sWks
    ActiveWorkbook.SaveAs Filename:=sPath & sFile
    ActiveSheet.Cells.Select
    Selection.ClearContents
     i = 17
     For b = 18 To 1000
      zellinhalt = ThisWorkbook.ActiveSheet.Range("G" & b).Value
       Select Case zellinhalt
        Case "n", "v", "a", "s"
        i = i + 1
        ThisWorkbook.ActiveSheet.Rows(b & ":" & b).EntireRow.Copy
        Workbooks(sFile).Sheets(sWks).Range("A" & i).Select
        ActiveSheet.Paste
        If Workbooks(sFile).Sheets(sWks).Range("d" & i) = "" And Not Workbooks(sFile).Sheets(sWks).Range("e" & i) = "" Then
                    Workbooks(sFile).Sheets(sWks).Range("h" & i) = "=R" & i & "C9/R" & i & "C3"
        Else
                    Workbooks(sFile).Sheets(sWks).Range("i" & i) = "=R" & Count & "C8*R" & i & "C3"
        End If
       End Select
      Next b
    Range("A18:L1000").Select   <------ Select Method of Range class Failed Error 1004
    Range("A18").Activate       <------ Active Class of Range class Failed Error 1004
    Selection.Sort Key1:=Range("G18"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom <----- auch fehler,der wird aber auf die Fehler davor beruhen
    ActiveSheet.Shapes("CommandButton1").Delete
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    End Sub
    


    Also was kann da Falsch sein ???


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Marc
    Geschrieben am: 01.10.2003 15:29:27

    Probier mal das hier :

    Range("A18:L1000").Select <------ Select Method of
    Range class Failed Error 1004

    ändern in:
    Workbooks(sFile).Sheets(sWks).Range("A18:L1000").Select

    Range("A18").Activate <------ Active Class of Range class Failed Error 1004
    weglassen

    Selection.Sort Key1:=Range("G18"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom <----- auch fehler,der wird aber auf die Fehler davor beruhen


    Diese beiden Zeilen sind eine einzige Anweisung, wenn die Zeilentrennung (Unterstrich "_") nicht erkannt wird, schreib's in eine Zeile.

    Grüsse,
    Marc


      


    Betrifft: AW: Copy wenn A und nicht ganzes Tabellenblatt von: Sven
    Geschrieben am: 01.10.2003 15:46:23

    Selection.Sort Key1:=Range("G18"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Das bringt immernoch fehler:
    wenn die Zelle leer ist,spinnt er rum und wenn ich das so ändere das er in einer vollen zelle anfängt kommt wieder : Sort Method of Range class Failed 'error 1004


      


    Betrifft: Sorry, weiss auchnicht weiter... von: Marc
    Geschrieben am: 01.10.2003 16:06:14

    Hey Sven,

    da weiss ich nun auch nicht weiter, schmeiss die Selection...-Zeile und die darüber raus.
    Und sortier dann manuell(kompletten Bereich markieren -> Daten -> Sortieren).

    Sorry,
    Marc


     

    Beiträge aus den Excel-Beispielen zum Thema " Copy wenn A und nicht ganzes Tabellenblatt"