Microsoft Excel

Herbers Excel/VBA-Archiv

Macro Hilfe FCS

Betrifft: Macro Hilfe FCS von: Thomas
Geschrieben am: 21.06.2015 16:22:03

Hallo,

Franz hatt mir mal dieses kopiermacro erstellt. Kann dies jemand ändern?

Es geht darum das ich im Tabellenblatt "vorgang" ( Ausgangstabelle) in den Spalten B und E eine Formel zu stehen habe. Beim ausführen des macros werden diese Formeln mit kopiert dies führt leider zu Fehlern. Bekommt ihr das hin das nur die Werte kopiert werden?

lieben dank schon mal für euer bemühen

Thomas

Sub monatsauswertung1()                                   '                      _
prcCopyDatumsbereich()
  Dim wksQuelle As Worksheet
  Dim wksZiel As Worksheet
  
  Dim Zeile_Z1 As Long, Zeile_Z As Long, Zeile_Q As Long, StatusCalc As Long
  Dim rngCopy As Range
  Dim varStart As Variant, varEnde As Variant, SpalteDatum As Long
  Dim Spalte_Q As Long, Spalte_Z As Long, SpalteDatum_Z As Long
  
  With Application
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  Set wksZiel = ActiveWorkbook.Worksheets("monatsauswertung") '2 ggf. durch Blattname in _
          Anführungszeichen ersetzen
  
  SpalteDatum = 8  'Spalte D - Spalte mit Datum in Quelltabelle
  SpalteDatum_Z = SpalteDatum  'Spalte mit Datum in Zieltabelle. Die beiden _
      Spalten müssen identisch sein, wenn ganze Zeilen kopiert werden!!!
  
  With wksZiel
  
    varStart = .Range("A1")
    varEnde = .Range("A2")
    
    Zeile_Z1 = 4 '1. Einfügezeile für kopierte Daten
    'letzte Zeile mit Daten in Datumsspalte
    Zeile_Z = .Cells(.Rows.Count, SpalteDatum_Z).End(xlUp).Row
    If Zeile_Z >= Zeile_Z1 Then
      'Altdaten löschen
      .Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).ClearContents
    End If
    Zeile_Z = Zeile_Z1 - 1 'Startzähler setzen
  End With
  
  Set wksQuelle = ActiveWorkbook.Worksheets("vorgang") '1 ggf. durch Blattname in _
        Anführungszeichen ersetzen
  
  With wksQuelle
  For Zeile_Q = 1 To .Cells(.Rows.Count, SpalteDatum).End(xlUp).Row
    If IsDate(.Cells(Zeile_Q, SpalteDatum)) Or Zeile_Q = 1 Then
      'Prüfkriterien
      If (.Cells(Zeile_Q, SpalteDatum) >= varStart _
          And .Cells(Zeile_Q, SpalteDatum) <= varEnde) Or Zeile_Q = 1 Then

        Zeile_Z = Zeile_Z + 1
'ganze Zeile kopieren
'        Set rngCopy = .Rows(Zeile_Q)
'        rngCopy.Copy wksZiel.Cells(Zeile_Z, 1)

'GoTo Weiter
'nur bestimmte Spalten kopieren
        SpalteDatum_Z = 2 'Datumspalte in Zieltabelle
        'Zelle in Datumsspalte kopieren
        Spalte_Z = SpalteDatum_Z
        Set rngCopy = .Cells(Zeile_Q, SpalteDatum)
        rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)
        
        For Spalte_Q = 1 To 135 'Nummer letzte Spalte ggf. anpassen
            Set rngCopy = Nothing
            Select Case Spalte_Q
                Case SpalteDatum
                    'do nothing - Spalte wurde vor For-Next-Schleife kopiert
                 Case 1 To 4, 5 To 6, 16, 19, 30, 93, 120, 133    'Spalten eintragen die  _
kopiert werden
                
                    'Zellen in diesen Spalten kopieren
                    Spalte_Z = Spalte_Z + 1
                    Set rngCopy = .Cells(Zeile_Q, Spalte_Q)
                Case Else
                    'do nothing
            End Select
            If Not rngCopy Is Nothing Then
                rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)
            End If
        Next Spalte_Q
Weiter:
      End If
    End If
  Next Zeile_Q
  End With
  
  If Zeile_Z > Zeile_Z1 + 1 Then
    With wksZiel
      .Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
          Key1:=.Cells(Zeile_Z1, SpalteDatum_Z), order1:=xlAscending, Header:=xlYes
    End With
  End If

  With Application
    .ScreenUpdating = False
    .Calculation = StatusCalc
  End With
End Sub

  

Betrifft: AW: Macro Hilfe FCS von: Werner
Geschrieben am: 21.06.2015 17:31:21

Hallo Thomas,

jeweils beim Kopieren nur die Werte einfügen. Die entsprechenden Codezeilen ändern in (hier exemplarisch für eine Codezeilen):

Von

rngCopy.Copy wksZiel.Cells(Zeile_Z, 1)
In
rngCopy.Copy wksZiel.Cells(Zeile_Z, 1).PasteSpecial Paste:=xlValues
Gruß Werner


  

Betrifft: AW: Macro Hilfe FCS von: Thomas
Geschrieben am: 21.06.2015 17:50:10

Hallo Werner,

erstmal lieben dank für die unterstützung.

Leider bekomme ich eine fehlermeldung.

"erwartet Anweisungsende"

ich habe die zeile

rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)


mit diener Zeile ersetzt.

Kannst Du nochmal schauen?

liebe grüsse thomas


  

Betrifft: AW: Macro Hilfe FCS von: fcs
Geschrieben am: 21.06.2015 19:07:40

Hallo Thomas,

die PasteSpecial-Anweisung muss in einer separaten Zeile stehen, nicht als Parameter der Copy-Anweisung. Kann man dann z.B. wie folgt lösen. Dabei PasteSpecial dann nur bei den bei den Spalten mit Formeln ausgeführt.

Gruß
Franz

              If Not rngCopy Is Nothing Then
                Select Case Spalte_Q
                    Case 2, 5 'Spalten B und E
                        'Spalten bei denen nur Formate und Werte kppiert werden sollen
                        rngCopy.Copy
                        With wksZiel.Cells(Zeile_Z, Spalte_Z)
                            .PasteSpecial Paste:=xlPasteFormats
                            .PasteSpecial Paste:=xlpastevalue
                            Application.CutCopyMode = False
                        End With
                    Case Else
                        rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)
                End Select
              End If



  

Betrifft: die rettung FCS von: Thomas
Geschrieben am: 21.06.2015 19:33:52

Hallo Franz,

du bist mal wieder meine Rettung.

Bestimmt habe ich es falsch eingefügt ich bekomme die Meldung

" Variable nicht definiert"

bei xlpastevalue


rettest Du mich ?


Liebe Grüsse Thomas

Sub monatsauswertung1()                                   '                      _
prcCopyDatumsbereich()
  Dim wksQuelle As Worksheet
  Dim wksZiel As Worksheet
  
  Dim Zeile_Z1 As Long, Zeile_Z As Long, Zeile_Q As Long, StatusCalc As Long
  Dim rngCopy As Range
  Dim varStart As Variant, varEnde As Variant, SpalteDatum As Long
  Dim Spalte_Q As Long, Spalte_Z As Long, SpalteDatum_Z As Long
  
  With Application
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  Set wksZiel = ActiveWorkbook.Worksheets("monatsauswertung") '2 ggf. durch Blattname in _
          Anführungszeichen ersetzen
  
  SpalteDatum = 8  'Spalte D - Spalte mit Datum in Quelltabelle
  SpalteDatum_Z = SpalteDatum  'Spalte mit Datum in Zieltabelle. Die beiden _
      Spalten müssen identisch sein, wenn ganze Zeilen kopiert werden!!!
  
  With wksZiel
  
    varStart = .Range("A1")
    varEnde = .Range("A2")
    
    Zeile_Z1 = 4 '1. Einfügezeile für kopierte Daten
    'letzte Zeile mit Daten in Datumsspalte
    Zeile_Z = .Cells(.Rows.Count, SpalteDatum_Z).End(xlUp).Row
    If Zeile_Z >= Zeile_Z1 Then
      'Altdaten löschen
      .Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).ClearContents
    End If
    Zeile_Z = Zeile_Z1 - 1 'Startzähler setzen
  End With
  
  Set wksQuelle = ActiveWorkbook.Worksheets("vorgang") '1 ggf. durch Blattname in _
        Anführungszeichen ersetzen
  
  With wksQuelle
  For Zeile_Q = 1 To .Cells(.Rows.Count, SpalteDatum).End(xlUp).Row
    If IsDate(.Cells(Zeile_Q, SpalteDatum)) Or Zeile_Q = 1 Then
      'Prüfkriterien
      If (.Cells(Zeile_Q, SpalteDatum) >= varStart _
          And .Cells(Zeile_Q, SpalteDatum) <= varEnde) Or Zeile_Q = 1 Then

        Zeile_Z = Zeile_Z + 1
'ganze Zeile kopieren
'        Set rngCopy = .Rows(Zeile_Q)
'        rngCopy.Copy wksZiel.Cells(Zeile_Z, 1)

'GoTo Weiter
'nur bestimmte Spalten kopieren
        SpalteDatum_Z = 2 'Datumspalte in Zieltabelle
        'Zelle in Datumsspalte kopieren
        Spalte_Z = SpalteDatum_Z
        Set rngCopy = .Cells(Zeile_Q, SpalteDatum)
        rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)
        
        For Spalte_Q = 1 To 135 'Nummer letzte Spalte ggf. anpassen
            Set rngCopy = Nothing
            Select Case Spalte_Q
                Case SpalteDatum
                    'do nothing - Spalte wurde vor For-Next-Schleife kopiert
                 Case 3 To 4, 5 To 6, 16, 19, 30, 93, 120, 133    'Spalten eintragen die  _
kopiert werden
                
                    'Zellen in diesen Spalten kopieren
                    Spalte_Z = Spalte_Z + 1
                    Set rngCopy = .Cells(Zeile_Q, Spalte_Q)
                Case Else
                    'do nothing
            End Select
            If Not rngCopy Is Nothing Then
                Select Case Spalte_Q
                    Case 2, 5, 6 'Spalten B und E
                        'Spalten bei denen nur Formate und Werte kppiert werden sollen
                        rngCopy.Copy
                        With wksZiel.Cells(Zeile_Z, Spalte_Z)
                            .PasteSpecial Paste:=xlPasteFormats
                            .PasteSpecial Paste:=xlpastevalue
                            Application.CutCopyMode = False
                        End With
                    Case Else
                        rngCopy.Copy wksZiel.Cells(Zeile_Z, Spalte_Z)
                End Select
              End If
        Next Spalte_Q
Weiter:
      End If
    End If
  Next Zeile_Q
  End With
  
  If Zeile_Z > Zeile_Z1 + 1 Then
    With wksZiel
      .Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
          Key1:=.Cells(Zeile_Z1, SpalteDatum_Z), order1:=xlAscending, Header:=xlYes
    End With
  End If

  With Application
    .ScreenUpdating = False
    .Calculation = StatusCalc
  End With
End Sub



  

Betrifft: AW: die rettung FCS von: fcs
Geschrieben am: 21.06.2015 20:42:45

Hallo Thomas,

da hatte ich am Ende ein "s" vergessen

                            .PasteSpecial Paste:=xlPasteValues
Gruß
Franz


  

Betrifft: es klappt besten Dank von: Thomas
Geschrieben am: 22.06.2015 05:37:44

Hallo Franz,


vielen vielen Dank es klappt.


liebe grüsse Thomas