Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1432to1436
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
Inhaltsverzeichnis

Macro Hilfe FCS

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

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

Betreff
Datum
Anwender
Anzeige
AW: Macro Hilfe FCS
21.06.2015 17:31:21
Werner
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

AW: Macro Hilfe FCS
21.06.2015 17:50:10
Thomas
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

Anzeige
AW: Macro Hilfe FCS
21.06.2015 19:07:40
fcs
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

Anzeige
die rettung FCS
21.06.2015 19:33:52
Thomas
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

Anzeige
AW: die rettung FCS
21.06.2015 20:42:45
fcs
Hallo Thomas,
da hatte ich am Ende ein "s" vergessen
                            .PasteSpecial Paste:=xlPasteValues
Gruß
Franz

es klappt besten Dank
22.06.2015 05:37:44
Thomas
Hallo Franz,
vielen vielen Dank es klappt.
liebe grüsse Thomas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige