Loop through all worksheets, exclude sheets in an array from Macro-CodePudding

I have a workbook with 45 sheets. I would like to write a code that loops through each sheet and for sheets NOT in an exclusion array, perform the task of copying the last row, pasting it to the following row, and copying over the original row as text only.

Here is the code that I have currently:

Sub updatereport()

Dim ws As Worksheet
Dim ArrayOne() As Variant
Dim wsName As Variant
Dim Matched As Boolean

ArrayOne = Array("Sheet1", "Sheet5", "Sheet7", "Sheet8", "Sheet10", "Sheet25", "Sheet27", "Sheet41", "Sheet43", "Sheet44", "Sheet45")

Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
    Matched = False
        For Each wsName In ArrayOne
            If wsName = ws.Name Then
            Matched = True
            Exit For
        End If
    Next
    If Not Matched Then
    
    Range("A" & Rows.Count).End(xlUp).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    Next ws
    
    
Application.DisplayAlerts = True
        
End Sub

The problem I'm having is that this does not loop through each worksheet, it only copies the last row down 10 rows on the active worksheet. What am I doing wrong here?

CodePudding user response：

This will run the code on all the sheets not named in ArrayOne.

Option Explicit

Sub updatereport()
Dim ws As Worksheet
Dim rngCopy As Range
Dim ArrayOne() As Variant
Dim Matched As Variant

    ArrayOne = Array("Sheet1", "Sheet5", "Sheet7", "Sheet8", "Sheet10", _
                     "Sheet25", "Sheet27", "Sheet41", "Sheet43", "Sheet44", "Sheet45")

    Application.DisplayAlerts = False

    For Each ws In ThisWorkbook.Worksheets
        Matched = Application.Match(ws.Name, ArrayOne, 0)

        If Not IsError(Matched) Then
            With ws
                Set rngCopy = .Range(.Range("A" & Rows.Count).End(xlUp), _
                                     .Range("A" & Rows.Count).End(xlUp).End(xlToRight))
                rngCopy.Copy rngCopy.Offset(1)
                rngCopy.Copy
                rngCopy.PasteSpecial Paste:=xlPasteValues
            End With
        End If
    Next ws

    Application.DisplayAlerts = True

End Sub

CodePudding user response：

as Brax noted, your ranges are not qualified. There are also better approaches using variant arrays which will run much quicker than selection and pasting of ranges. I am assuming the last row contains formulas you wish to retain, so pushing those down a row and keeping the previous row as values only. If so, the following provides an alternative approach:

(edit - misread, that you wanted items "not" in the list. Updated and refined).

Option Explicit

Sub updatereport()

Dim ws As Worksheet
Dim ArrayOne() As Variant
Dim wsName As Variant

Dim rng1 As Variant
Dim rng2 As Variant
Dim lastrow As Long

Dim InTheList As Boolean

ArrayOne = Array("Sheet1", "Sheet3", "Sheet7", "Sheet8", "Sheet10", "Sheet25", "Sheet27", "Sheet41", "Sheet43", "Sheet44", "Sheet45")

    For Each ws In ThisWorkbook.Worksheets
        
        InTheList = Not (IsError(Application.Match(ws.Name, ArrayOne, 0)))
        
        If Not InTheList Then
            
            lastrow = ws.Cells(ws.rows.Count, 1).End(xlUp).row
            
            rng1 = ws.rows(lastrow).Value2 ' get values only
            rng2 = ws.rows(lastrow).FormulaR1C1 ' get any values and formulae
            
            ws.rows(lastrow).Value2 = rng1 ' place values
            ws.rows(lastrow   1).FormulaR1C1 = rng2 ' place values and formulae
        
        End If

    Next ws
        
End Sub