Search code examples
excelvbareturn-valuecopy-pastepaste

VBA to Paste as value and loop through specific sheets


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

Solution

  • 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