如何確定我只是復制和粘貼值而沒有格式？

早上好，

我試過，ActiveCell.PasteSpecial Paste:=xlPasteValues但它不起作用。

Sub CopyCoverage()

Dim x As Worksheet, y As Worksheet, LastRow


Set x = Sheets("1SalesAnalysis")
Set y = Sheets("Basics")

LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row

x.Range("A2:A" & LastRow).Copy y.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
x.Range("B2:B" & LastRow).Copy y.Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
x.Range("C2:C" & LastRow).Copy y.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0)
x.Range("D2:D" & LastRow).Copy y.Cells(Rows.Count, "L").End(xlUp).Offset(1, 0)

x.Range("E2:E" & LastRow).Copy y.Cells(Rows.Count, "M").End(xlUp).Offset(1, 0)
x.Range("F2:F" & LastRow).Copy y.Cells(Rows.Count, "P").End(xlUp).Offset(1, 0)
x.Range("G2:G" & LastRow).Copy y.Cells(Rows.Count, "Q").End(xlUp).Offset(1, 0)
x.Range("H2:H" & LastRow).Copy y.Cells(Rows.Count, "R").End(xlUp).Offset(1, 0)

x.Range("I2:I" & LastRow).Copy y.Cells(Rows.Count, "S").End(xlUp).Offset(1, 0)
x.Range("J2:J" & LastRow).Copy y.Cells(Rows.Count, "T").End(xlUp).Offset(1, 0)
x.Range("K2:K" & LastRow).Copy y.Cells(Rows.Count, "V").End(xlUp).Offset(1, 0)
x.Range("L2:L" & LastRow).Copy y.Cells(Rows.Count, "W").End(xlUp).Offset(1, 0)

x.Range("O2:O" & LastRow).Copy y.Cells(Rows.Count, "EA").End(xlUp).Offset(1, 0)
x.Range("P2:P" & LastRow).Copy y.Cells(Rows.Count, "EI").End(xlUp).Offset(1, 0)
x.Range("Q2:Q" & LastRow).Copy y.Cells(Rows.Count, "EB").End(xlUp).Offset(1, 0)

x.Range("R2:R" & LastRow).Copy y.Cells(Rows.Count, "EJ").End(xlUp).Offset(1, 0)
x.Range("S2:S" & LastRow).Copy y.Cells(Rows.Count, "EC").End(xlUp).Offset(1, 0)
x.Range("T2:T" & LastRow).Copy y.Cells(Rows.Count, "EK").End(xlUp).Offset(1, 0)

ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End Sub

謝謝

此致

uj5u.com熱心網友回復：

避免格式不被復制/粘貼的最佳方法是首先不復制/粘貼：您可以簡單地執行以下操作：

Destination_Range.Value = Source_Range.Value

像這樣，只有值被復制”，但不涉及格式。

可以在有關此主題的參考問題中找到更多資訊。

uj5u.com熱心網友回復：

將映射規則存盤在一個陣列中，以便您可以對每一列重復使用相同的代碼。

Option Explicit

Sub CopyCoverage()

    Dim wsX As Worksheet, wsY As Worksheet
    Dim LastRowX As Long, msg As String
    Dim rngX As Range, rngY As Range
    
    Set wsX = Sheets("1SalesAnalysis")
    Set wsY = Sheets("Basics")
    LastRowX = wsX.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    Dim map, ar, i As Integer
    map = Split("A=>E,B=>F,C=>G,D=>L,E=>M,F=>P,G=>Q,H=>R,I=>S,J=>T,K=>V,L=>W," & _
                "O=>EA,P=>EI,Q=>EB,R=>EJ,S=>EC,T=>EK", ",")
    
    Application.ScreenUpdating = False
    For i = 0 To UBound(map)
        ar = Split(map(i), "=>")
        msg = msg & vbLf & ar(0) & " to " & ar(1)

        Set rngX = wsX.Range(ar(0) & "2:" & ar(0) & LastRowX)
        Set rngY = wsY.Cells(Rows.Count, ar(1)).End(xlUp).Offset(1, 0)
        rngY.Resize(rngX.Rows.Count).Value2 = rngX.Value2
    Next
    Application.ScreenUpdating = True
    MsgBox "Copied " & msg, vbInformation

End Sub

uj5u.com熱心網友回復：

那些一行“復制粘貼”已經完成了復制粘貼的任務，因此代碼底部的 ActiveCell.PasteSpecial 不會做任何事情。

有幾種方法可以做到，但我會堅持你的代碼模式：

Sub CopyCoverage()
    
    Dim x           As Worksheet
    Dim y           As Worksheet
    Dim LastRow     As Long
    
    Set x = ThisWorkbook.Sheets("Sheet2")
    Set y = ThisWorkbook.Sheets("Ans")

    LastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    Application.ScreenUpdating = False '~turn off the 'animation' to speed up a bit
    
    'The logic will be, copy-paste, copy-paste
    x.Range("A2:A" & LastRow).Copy
    y.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    x.Range("B2:B" & LastRow).Copy
    y.Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
    'and so and so forth
    'Just continue with this pattern
    
    Application.CutCopyMode = False '~end line
    Application.ScreenUpdating = True '~turn on the 'animation' again
    
End Sub

標籤：擅长 vba

上一篇：Excel將字母串列拆分為單元格以生成所有組合

下一篇：創建DLL并從Excel中使用它