粘貼值到一張紙上

Question

我有大約30工作表（該月的天數），並在每張紙上

我想的值範圍A293:AL293和A296:AL296每個工作表上覆制我的活動工作表（例如，從本月1日至30日的連續行）。

這些範圍分別使用MIN和PERCENTILE公式。但是，當我運行宏時，單元格包含！REF錯誤，因爲複製了公式而不是實際的單元格值。

我應該如何修改宏，以便它將複製和粘貼值而不是公式？

，我從我曾經從30張複製並粘貼數據形成爲一個片另一個宏修改的代碼是：

Sub test() 
Dim curRow As Integer 
Dim activeWorksheet As Worksheet 
Set activeWorksheet = ActiveSheet 
curRow = 1 
For Each ws In ActiveWorkbook.Worksheets 
    If Not ws.Name = activeWorksheet.Name Then 
     ws.Range("A293:AL293").Copy Destination:=activeWorksheet.Range(CStr(curRow) & ":" & CStr(curRow + 288)) 
    curRow = curRow + 289 
    End If 
Next ws 
End Sub 

另一個代碼我發現了：

Option Explicit 
Sub CreateTempPSDReport() 
Dim WS As Worksheet, Rept As Worksheet 

Set Rept = Sheets("Temporary PSD Report") 
Application.ScreenUpdating = False 

'--> Loop through each worksheet except the report and 
'--> Copy the set range to the report 
For Each WS In ThisWorkbook.Worksheets 
    If Not WS.Name = "Temporary PSD Report" Then 
     WS.Range("A42", "I42").Rows.Copy 
     Rept.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _ 
     Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    End If 
Next 
Application.ScreenUpdating = True 
End Sub 

但我不確定什麼是

 WS.Range("A42", "I42").Rows.Copy 
     Rept.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _ 
     Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

部分。

謝謝！

Answer 1

要將這對行復制到彙總表中，您可以執行此操作。兩點注意事項

• 使用.Value複製了值而不是公式。在這種情況下，我用.Value2

• 你不需要複製和粘貼（除非你想複製格式），你可以簡單地設置一個範圍等於值在另一個

  Sub test() 
  Dim ws1 As Worksheet 
  Dim ws2 As Worksheet 
  Dim lngCnt As Long 
  
  Set ws1 = ActiveSheet 
  Application.ScreenUpdating = False 
  For Each ws2 In ActiveWorkbook.Worksheets 
      If Not ws1.Name = ws2.Name Then 
       ws1.[a1].Offset(lngCnt, 0).Resize(1, 38).Value2 = ws2.Range("A293:AL293").Value2 
       ws1.[a1].Offset(lngCnt + 1, 0).Resize(1, 38).Value2 = ws2.Range("A296:AL296").Value2 
       lngCnt = lngnct + 2 
      End If 
  Next ws2 
  Application.ScreenUpdating = True 
  End Sub