Home » excel » excel – VBA to Paste as value and loop through specific sheets

excel – VBA to Paste as value and loop through specific sheets

Posted by: admin May 14, 2020 Leave a comment

Questions:

I need my code to copy and paste values from only 2 specific sheets “Pro Rate” & “Weekly Labor” These two sheets have the same 9 columns that I want copied over.

The problem is my code is copying all 20+ sheets and pasting with formulas so essentially I get all NAs

I’ve tried using a code:

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
How to&Answers:

First, you need to run a check to make sure that the sheet names match the ones you want to copy.

Second you need to use .PasteSpecial to ensure only values are pasted.

I have updated only the above 2 things in your code below…

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