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

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

其次，您需要使用 .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

VBA 粘贴为值并循环遍历特定工作表

VBA to Paste as value and loop through specific sheets

excel

vba

copy-paste

return-value

paste