Home > Mobile >  Loop Through All Sheets In Workbook And Copy/Paste Match To Summary Sheet
Loop Through All Sheets In Workbook And Copy/Paste Match To Summary Sheet

Time:05-14

I am trying to develop an Excel VBA sheet where there is a summary sheet. The program has to loop through all the active sheets with the title "revision" in it and be able to copy and paste everything from the latest revision worksheet if nothing is present in the current revision sheet. But if it does find something from a previous revision sheet, it has to up to counter on the summary sheet for the line.

For example, it would be something like this on the summary page:

Revision Title

0 Apple

Loop through all sheets

Find apple on revision 1 sheet

Paste apple revision 1 to summary sheet

Revision Title

1 Apple

My code is this so far, but I don't think it is on the right track, where "BOM" is the summary sheet from the example above. The code would also have to loop through all rows until it detects the first blank row then, move on to the next sheet until there are no more sheets with the name "revision" on it.


Dim wkst As Worksheet
Dim row As Long 'if you ever exceed 32,000 this will fail as integer
row = 1
For Each wkst In ActiveWorkbook.Worksheets
' loop through the Open worksheets
   If wkst.Name <> "Summary" Then
        Sheets("BOM").Range("B2").Value = Worksheets(I   1).Range("B2")
        Sheets(I   1).Range("B2").Copy
        Sheets("BOM").Range("B5").PasteSpecial xlPasteValues
      row = row   1
   End If

Next
    
End Sub

CodePudding user response:

I'm sorry because it's difficult for me to understand what you want.
Especially you mentioned a sheet with name "summary" and a sheet with name "BOM".

Anyway, below is my guess on what you want

enter image description here

The code assumed that the one which look in the picture above on column A is the data in column A of sheet "rev1", column C is the data in column A of sheet "rev2" and column E is the data in column A of sheet "rev3".

The goal is to calculate how many occurance of all existing data on all sheets which name contains "rev".

So, based on the sample as seen in the picture, the expected result is the one in the picture of column G which will be put in sheet with name "summary" column A. For example : the occurance of title "AA" is two times (2 AA) which is one time in sheet "rev1" and one time in sheet "rev2" .... the occurance of title "G" is four times (4 GG) which is one time in sheet "rev1" and two times in sheet "rev2" and one time in sheet "rev3".... and so on. The title which doesn't exist on other "rev" sheet is the unique one, with prefix "1".

Sub test()
Dim arr As Object: Set arr = CreateObject("scripting.dictionary")
Dim el As Variant
Dim sh As Worksheet
Dim cnt As Integer
Dim c as Range

For Each sh In Worksheets
    If InStr(sh.Name, "rev") Then _
        For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp)): arr(c.Value) = 1: Next
Next


For Each el In arr
    For Each sh In Worksheets
        If InStr(sh.Name, "rev") Then cnt = cnt   Application.CountIf(sh.Range("A:A"), el)
    Next sh
Sheets("summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = CStr(cnt) & " " & el
cnt = 0
Next el

End Sub

What the code do :
It collects all the unique value on each sheets with name contains "rev" starts from cell A2 down to whatever row with the last value into variable arr.

then it loops to each element in arr to count how many occurance of the element are there on each sheet with name contains "rev" and keep it into variable cnt.

then finally it write the cnt value & the element name in sheet "summary" column A.

  • Related