Excel VBA Course

(35% Sale Ends Jan. 26)

Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course (35% Discount)

loop in specific sheets instead of one sheet

0

hi guys

 I search for way to do  loop for specific sheets(sh1,imp1,inv1) instead of sheet1. the code copies  specific columns based on specific headers and shows the result in sheet result .

Sub TT()
Dim sWords As Variant
Dim Res As Variant
Dim idx As Long
Dim idxCol As Long
Dim cnt As Long

    sWords = Array("CODE", "BRAND")

    With Sheets("Sheet1")
        Res = Application.Match(sWords, .Rows(1), 0)

        For idx = LBound(Res) To UBound(Res)
            If Not IsError(Res(idx)) Then
                cnt = cnt + 1
                idxCol = Res(idx)
                .Columns(idxCol).Copy Sheets("result").Columns(cnt)
            End If
        Next idx
    End With
End Sub

thanks  in advance 

Answer
Discuss

Answers

0
Selected Answer

Hasson

You didn't attach a file so I can't tell if you have just those sheets plus another sheet for results (or several more). Assuming the latter, I've modified your code so you complete an array TargetSh with the specific sheet names you want then it checks all sheets against values in that array. Changes in bold below (with comments):

Sub TT()
Dim sWords As Variant
Dim Res As Variant
Dim idx As Long
Dim idxCol As Long
Dim cnt As Long
Dim TargetSh As Variant, Sh As Worksheet, n as long

sWords = Array("CODE", "BRAND")
'list the desired sheet names...
TargetSh = Array("sh1", "imp1", "inv1")

'loop though all sheets...
For Each Sh In ThisWorkbook.Worksheets
' check TargetSh array for this sheet name...
    For n = LBound(TargetSh) To UBound(TargetSh)
        ' check TargetSh array for this sheet name
        If Sh.Name = TargetSh(n) Then
        '... if it matches, do tasks...
            With Sh
                Res = Application.Match(sWords, .Rows(1), 0)

                For idx = LBound(Res) To UBound(Res)
                    If Not IsError(Res(idx)) Then
                        cnt = cnt + 1
                        idxCol = Res(idx)
                        .Columns(idxCol).Copy Sheets("result").Columns(cnt)
                    End If
                Next idx
            End With
        End If
    Next n

Next Sh

End Sub
If you only have a results sheet and want to act on all other sheets however, you don't need the array TargetSh, can remove the For/Next loop using n and make the test just:
If Sh.Name <> "result" Then
where you'd need to change "result" to the name of the sheet you don't want to act on.

Your late addition of a file and clarifications shows you want results from all sheets (other than results) to appear below each other (from column B for some reason). This code is cumbersomein parts (I leave you to tidy it up ND Add code to first clear the result sheet) but should work (changes from the above in bold)

Sub TT()
Dim sWords As Variant
Dim Res As Variant
Dim idx As Long
Dim idxCol As Long
Dim cnt As Long
Dim Sh As Worksheet

sWords = Array("CODE", "BRAND", "INVO")


'loop though all sheets...
For Each Sh In ThisWorkbook.Worksheets
' ignore "result"
        If Sh.Name <> "result" Then
        '... if it matches, do tasks...
            With Sh
                Res = Application.Match(sWords, .Rows(1), 0)

                For idx = LBound(Res) To UBound(Res)
                    If Not IsError(Res(idx)) Then
                        idxCol = Res(idx)
                        'copy header and format
                        .Cells(1, idxCol).Copy Sheets("result").Cells(1, idx + 1)
                        'work out the last used result row (for any column)...
                       LstRw = WorksheetFunction.Max(LstRw, Sheets("result").Cells(.Rows.Count, idx + 1).End(xlUp).Row)
                        'copy the data cells below existing data
                        .Range(.Cells(2, idxCol), .Cells(.Cells(.Rows.Count, idxCol).End(xlUp).Row, idxCol)).Copy Sheets("result").Cells(LstRw + 1, idx + 1)
                    End If
                Next idx
            End With
        End If
Next Sh

' adjust the populated columns
For n = 2 To UBound(Res) + 1
    Sheets("result").Columns(n + 1).AutoFit
Next n

End Sub
Note I added the search term"INVO" in the attached file to show it will copy blocks of data from sheets (which might not contain all items in the array sWords).

Hope this helps.

Discuss

Discussion

my apologies !  about  the  file   I attached   the  file   . 
there  is  a problem  when  match  the  headers into sheet RESULT with others  sheets  . it  should  copy  to  the  bottom  but  not  repeatedly  when  run  macro  every  time  . just  bring  all  of  data  across  multiple  sheets  and  put  the data below others of  them. current code    brings al lof  data for   each  column  individually not    below the  headers. I put   the  right  result  in sheet RESULT how  should  be 
thanks again
Hasson (rep: 12) Dec 2, '21 at 9:55 am
Mmm. Feels like I answered your question on looping through sheets (in two ways) but your file now extends the question to something else.

What if you have a third entry in the array sWords (e.g. "INVO") where not all sheets havevalues for that? I imagine you want "blocks" of data copied below each other but with possible different widths (maybe two columns from most sheets, three for inv1), right?
John_Ru (rep: 2867) Dec 2, '21 at 2:49 pm
I imagine you want "blocks" of data copied below each other but with possible different widths (maybe two columns from most sheets, three for inv1), right?
yes  you're  right.
Hasson (rep: 12) Dec 2, '21 at 3:06 pm
See my revised Answer.
John_Ru (rep: 2867) Dec 2, '21 at 4:14 pm
much  appreciated !
Hasson (rep: 12) Dec 2, '21 at 4:25 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login