Macro Hilfe FCS
21.06.2015 16:22:03
Thomas
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