问题
I am absolutely new to vba. I want to copy certain values in cells from two tabs ("Equities", "Bonds") into a third one ("ZSM") with the following code.
Sub AllesAufEinmal()
Call Spalten
Call Wertpapiere
Call Daten
End Sub
Sub Spalten()
'
' Spalten Macro
'
Sheets("Equities").Select
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Sheets("Bonds").Select
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Range("A4").Select
End Sub
Sub Wertpapiere()
'
' Wertpapiere Macro
'
'
Sheets("Equities").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A5").Select
ActiveSheet.Paste
Range("A5").Select
Sheets("Bonds").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A5").Select
End Sub
Sub Daten()
'
' Daten Macro
'
'
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.Paste
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.Paste
End Sub
That works fine until I wanted to modify the code in a way so that my vba code copies the values from my formulas in the two tabs ("Equities, Bonds") into my third tab ("ZSM"). I really only want the value the formula gives back from formulas like "= J5*K24" to be copied. That did not work even though I modified the code the following way (changes marked with "###here"):
Sub AllesAufEinmal()
Call Spalten
Call Wertpapiere
Call Daten
End Sub
Sub Spalten()
'
' Spalten Macro
'
Sheets("Equities").Select
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Sheets("Bonds").Select
Range("B4").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Range("A4").Select
End Sub
Sub Wertpapiere()
'
' Wertpapiere Macro
'
'
Sheets("Equities").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Range("A5").Select
ActiveSheet.Paste
Range("A5").Select
Sheets("Bonds").Select
Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ZSM").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A5").Select
End Sub
Sub Daten()
'
' Daten Macro
'
'
Sheets("Equities").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
ActiveSheet.PasteSpecial ###here
Sheets("Bonds").Select
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("ZSM").Select
Range("B5").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.PasteSpecial ###here
End Sub
Any ideas? I read a bit about the PasteSpecial Methode but could not apply it to my problem at this stage.
Thank your for your help! I would really appreciate your support.
EDIT: Screenshots as requested Attention: The column ISIN should only be there once in tab "ZSM". It should be possible to extend columns and rows.
回答1:
Using the direct value transfer methods described in your last question, I've come up with this.
Each part of the transfer is labelled so you can split the individual routines apart as needed.
Option Explicit
Sub AllesAufEinmal()
Dim tws As Worksheet
Set tws = Worksheets("ZSM")
Call Spalten(tws)
'Call Wertpapiere(tws)
'Call Daten(tws)
End Sub
Sub Spalten(zsm As Worksheet)
' Spalten Macro
'headers, ISIN and data from from Equities
With Worksheets("Equities")
With .Range(.Cells(.Rows.Count, "A").End(xlUp), .Cells(4, .Columns.Count).End(xlToLeft))
zsm.Cells(4, "A").Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'headers from Bonds
With Worksheets("Bonds")
With .Range(.Cells(4, "B"), .Cells(4, .Columns.Count).End(xlToLeft))
zsm.Cells(4, zsm.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'ISIN from Bonds
With Worksheets("Bonds")
With .Range(.Cells(5, "A"), .Cells(.Rows.Count, "A").End(xlUp))
zsm.Cells(zsm.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
'data from Bonds
With Worksheets("Bonds")
With .Range(.Cells(.Rows.Count, "B").End(xlUp), .Cells(5, .Columns.Count).End(xlToLeft))
zsm.Cells(zsm.Cells(zsm.Rows.Count, "B").End(xlUp).Row, _
zsm.Cells(5, zsm.Columns.Count).End(xlToLeft).Column). _
Offset(1, 1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
End With
End Sub
'Best practice' dictates that you should avoid Select and provide proper parent worksheet references. To this end, I've passed the target worksheet reference to each 'helper' sub procedure as a parameter.
回答2:
You should use xlPasteValues
. Example:
Range("B5").PasteSpecial xlPasteValues
If you prefer formulas you could use xlPasteFormulas
.
I strongly advise to read this article on how to avoid using Select
:
How to avoid using Select in Excel VBA
回答3:
You can try replacing those Activesheet.PasteSpecial
as:
Selection.PasteSpecial Paste:=xlPasteValues
This will paste your selected range as just values.
来源:https://stackoverflow.com/questions/52401097/paste-values-instead-of-formulas-with-pastespecial-vbanewbie