excel - VBA粘贴为值并遍历特定工作表

Question

我需要我的代码仅从 2 个特定工作表“Pro Rate”和“Weekly Labor”中复制和粘贴值。这两张工作表具有我想要复制的相同的 9 列。

问题是我的代码正在复制所有 20 多张纸并粘贴公式，所以基本上我得到了所有 NA

我试过使用代码:

Public Sub CombineDataFromAllSheets()

    Dim wksSrc As Worksheet, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    Set wksDst = ThisWorkbook.Worksheets("Import")
    lngDstLastRow = LastOccupiedRowNum(wksDst)

    Set rngDst = wksDst.Cells(2, 1)

    For Each wksSrc In ThisWorkbook.Worksheets
     If wksSrc.Name <> "Import" Then
    lngSrcLastRow = LastOccupiedRowNum(wksSrc)

    With wksSrc
    Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, 9))
    rngSrc.Copy Destination:=rngDst
    End With
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

    End If
      Next wksSrc


End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

Answer 1

首先，您需要运行检查以确保工作表名称与您要复制的名称匹配。

其次你需要使用.PasteSpecial以确保仅粘贴值。

我在下面的代码中只更新了上述两件事......

Public Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = LastOccupiedRowNum(wksDst)

Set rngDst = wksDst.Cells(2, 1)

For Each wksSrc In ThisWorkbook.Worksheets
 'first change here**
 If wksSrc.Name = "Pro Rate" Or wksSrc.Name = "Weekly Labor" Then
lngSrcLastRow = LastOccupiedRowNum(wksSrc)

With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, 9))
'second change here**
rngSrc.Copy
rngDst.PasteSpecial Paste:=xlPasteValues
End With
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

End If
  Next wksSrc
End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
    With Sheet
        lng = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
    End With
Else
    lng = 1
End If
LastOccupiedRowNum = lng
End Function