Ik moet meerdere shapes copieren en heb daarvoor de volgende macro in gebruik.
Ik krijg echter bij de PasteSpecial de foutmelding:
Run-time error 1004
PasteSpecial Method of worksheet class failed
Wat doe ik fout?
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "*_grafiek" Then
Sheets(sh.Name).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.copy
Sheets("Graphs_Overview").Select
If ActiveSheet.Shapes.Count = 0 Then
Range("$A$1").Select
ActiveSheet.Paste
count_shapes1 = ActiveSheet.Shapes.Count
Range("$Z$10").Select
ActiveCell.FormulaR1C1 = ActiveSheet.Shapes(count_shapes2).BottomRightCell.Row + 2
Else
Call LastRowInOneColumn
where_text = "$A$" & Range("$Z$9")
Range(where_text).Select
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Range("$A$1").Select
' ActiveSheet.Paste
count_shapes2 = ActiveSheet.Shapes.Count
Range("$Z$10").Select
ActiveCell.FormulaR1C1 = ActiveSheet.Shapes(count_shapes2).BottomRightCell.Row + 2
End If
Sheets(sh.Name).Select
Dim till_where As Range
Set till_where = Range("$O$2")
Range("A1:M" & till_where).Select
Selection.copy
Sheets("Graphs_Overview").Select
put_where = "$A$" & Range("$Z$10")
Application.Wait Now + TimeValue("00:00:01")
'MsgBox put_where
Range(put_where).Select
ActiveSheet.Paste
End If
Next sh
Ik krijg echter bij de PasteSpecial de foutmelding:
Run-time error 1004
PasteSpecial Method of worksheet class failed
Wat doe ik fout?
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "*_grafiek" Then
Sheets(sh.Name).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.copy
Sheets("Graphs_Overview").Select
If ActiveSheet.Shapes.Count = 0 Then
Range("$A$1").Select
ActiveSheet.Paste
count_shapes1 = ActiveSheet.Shapes.Count
Range("$Z$10").Select
ActiveCell.FormulaR1C1 = ActiveSheet.Shapes(count_shapes2).BottomRightCell.Row + 2
Else
Call LastRowInOneColumn
where_text = "$A$" & Range("$Z$9")
Range(where_text).Select
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Range("$A$1").Select
' ActiveSheet.Paste
count_shapes2 = ActiveSheet.Shapes.Count
Range("$Z$10").Select
ActiveCell.FormulaR1C1 = ActiveSheet.Shapes(count_shapes2).BottomRightCell.Row + 2
End If
Sheets(sh.Name).Select
Dim till_where As Range
Set till_where = Range("$O$2")
Range("A1:M" & till_where).Select
Selection.copy
Sheets("Graphs_Overview").Select
put_where = "$A$" & Range("$Z$10")
Application.Wait Now + TimeValue("00:00:01")
'MsgBox put_where
Range(put_where).Select
ActiveSheet.Paste
End If
Next sh