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.
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.
You can try replacing those Activesheet.PasteSpecial
as:
Selection.PasteSpecial Paste:=xlPasteValues
This will paste your selected range as just values.
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
:
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.