vba - 使用 PasteSpecial 粘贴值而不是公式 - VBANewbie

Question

我对 vba 完全陌生。我想使用以下代码将单元格中的某些值从两个选项卡(“股票”、“债券”)复制到第三个选项卡(“ZSM”)。

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

这很好用，直到我想以某种方式修改代码，以便我的 vba 代码将两个选项卡(“股票，债券”)中公式中的值复制到我的第三个选项卡(“ZSM”)中。我真的只想复制公式从“= J5*K24”之类的公式返回的值。即使我按照以下方式修改了代码(更改标记为“###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

有任何想法吗？我阅读了一些关于 PasteSpecial Methode 的内容，但在这个阶段无法将其应用于我的问题。

感谢您的帮助!我非常感谢您的支持。

编辑:按要求截图
注意:ISIN 列在“ZSM”选项卡中只能出现一次。应该可以扩展列和行。

Answer 1

使用您的 last question 中描述的直接值(value)转移方法，我想出了这个。

传输的每个部分都带有标签，因此您可以根据需要将各个例程分开。

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

“最佳实践”要求您应该 avoid Select并提供适当的父工作表引用。为此，我已将目标工作表引用作为参数传递给每个“助手”子过程。