VBA 复制该列最后一个非空单元格的值、格式和颜色

Question

我一直想复制 B 列中最后一个非空单元格的值以及格式和单元格颜色，并将其粘贴到所有工作表的单元格 B1 中。

这是我使用的代码，但我总是收到错误消息。

Sub copypaste()

   Dim wb As Workbook
   Dim ws As Worksheet
   Dim Lastcell As String


   Application.ScreenUpdating = False
   Set wb = ThisWorkbook
    For Each ws In wb.Worksheets

      Lastcell = ws.Cells(Rows.Count, "B").End(xlUp).Cell
      Lastcell.Copy
      ws.Range("B1").PasteSpecial Paste:=xlPasteFormats
      ws.Range("B1").PasteSpecial Paste:=xlPasteValue


    Next ws

  Set wb = Nothing
End Sub

能否请你帮忙？

提前致谢

Answer 1

您看起来将 Lastcell 声明为字符串，但将其视为范围。 像这样的东西会起作用。

Sub copypaste()

Dim wb As Workbook
Dim ws As Worksheet
Dim Lastcell As Range


Application.ScreenUpdating = False

Set wb = ThisWorkbook

    For Each ws In wb.Worksheets

    Set Lastcell = ws.Cells(Rows.Count, "B").End(xlUp)
    
    Lastcell.Copy
    
    ws.Range("B1").PasteSpecial Paste:=xlPasteValues
    ws.Range("B1").PasteSpecial Paste:=xlPasteFormats

    Next ws

  Set wb = Nothing
  
End Sub

Answer 2

多个工作表中的单元格复制

Option Explicit

Sub CopyPaste()

    Dim wb As Workbook: Set wb = ThisWorkbook

    Dim ws As Worksheet
    Dim sCell As Range ' Source Cell Range
    Dim dCell As Range ' Destination Cell Range

    Application.ScreenUpdating = False
   
    For Each ws In wb.Worksheets

        ' Cells...
        Set dCell = ws.Cells(1, "B")
        Set sCell = ws.Cells(ws.Rows.Count, "B").End(xlUp)
        
        ' ... or Range...
        'Set dCell = ws.Range("B1")
        'Set sCell = ws.Range("B" & ws.Rows.Count).End(xlUp)
        
        ' Fastest (if it covers what you need)
        dCell.Value = sCell.Value
        dCell.NumberFormat = sCell.NumberFormat
        dCell.Interior.Color = sCell.Interior.Color
    
        ' Fast
'        sCell.Copy dCell
'        dCell.Value = sCell.Value
        
        ' Slow (the selection changes)
'        sCell.Copy
'        dCell.PasteSpecial xlPasteValues
'        dCell.PasteSpecial xlPasteFormats
        
    Next ws

    ' Only for the Slow version:
    'Application.CutCopyMode = False
    
    Application.ScreenUpdating = True

End Sub