VBA to Paste as value and loop through specific sheets

Question

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

have you tried adding the worksheet names into your for each loop - at the moment its doing every sheet that is not called Import — JimmyShoe
– JimmyShoe, Commented Sep 13, 2019 at 14:55

DDV · Accepted Answer · 2019-09-13 14:58:37Z

2

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

answered Sep 13, 2019 at 14:58

DDV

2,4156 gold badges16 silver badges38 bronze badges

Sign up to request clarification or add additional context in comments.

6 Comments

Jonathan Marin Over a year ago

Thank you!!! this works perfect! just one more thing if you could.. when I run the macro, it does everything correct. But it leaves me at the bottom of the sheet, it didnt do that before. What can I add to make it take me to the top once I run the macro? There is over 40k lines so it will be a problem having to scroll up

JimmyShoe Over a year ago

to select cell A1 you would put Range("A1").Select in your code at the end before you end the sub

Jonathan Marin Over a year ago

@jimmyshoe after next wksSrc and before end sub i put "Activesheet.Range("a1") but i get an error when running it

SJR Over a year ago

Please can you accept the answer if it has helped? As per JimmyShoe you need Range("A1").Select.

Jonathan Marin Over a year ago

@jimmyshoe quick question.. do you know if its possible to run this macro but have it keep the formulas linked to other sheets?

|

Collectives™ on Stack Overflow

VBA to Paste as value and loop through specific sheets

1 Answer 1

6 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

6 Comments

Your Answer

Sign up or log in

Post as a guest

Related