CODEWITHSUNDEEP
vbaexcel
MisterYUE
MisterYUE

Reputation: 51

Collect Cell Values from Column in Other Worksheet of the same WorkBook

I'm new to VBA and I'm currently working on some Excel Files.

The File I'm looking at now has a thousand of sheets. Except for the first sheet, they all look the same, something like :

http://i.imgur.com/t5UMte3.png

The first sheet has the name of each sheet in each row of col B:

http://i.imgur.com/AlH3pm5.png

What I am trying to do is, for each cells in col E that has been filled, to write the value into the first-sheet, in its corresponding row. It's like writing a report into the first-sheet for each sheets. Hope I was clear enough ...

Here is my code: Right now it could only change the very first value of column B.

Sub macro()

    Dim c As Range
    Dim ws As Worksheet
    Dim d As Range
    Dim I As Integer

    For Each c In Feuil1322.UsedRange.Columns("B").Cells

        For Each ws In ActiveWorkbook.Worksheets

            If c.Value = ws.Name Then

                For Each d In ws.UsedRange.Columns("E").Cells
                    If Not IsEmpty(d.Value) Then
                    Feuil1322.Cells(c.End(xlUp).Row, 3).Formula = d.Value
                    End If
                Next

            End If

        Next

    Next

End Sub

Upvotes: 1

Views: 307

Answers (1)

user4039065
user4039065

Reputation:

The column header label in each of the child worksheets is important as it will be used as the filter header to filter out blanks from column E and collect all visible values (e.g. issue statements).

Sub macro()
    Dim wsI As Worksheet, ws As Worksheet
    Dim i As Long, rng As Range, str As String

    on error goto Safe_Exit
    application.screenupdating = false
    application.enableevents = false

    Set wsI = Worksheets("Issues")

    For Each ws In ActiveWorkbook.Worksheets
        With ws
            str = vbnullstring
            If .AutoFilterMode Then .AutoFilterMode = False
            If CBool(Application.CountIf(wsI.Columns(2), .Name)) And _
              Application.CountA(.Columns(5)) > 2 Then
                With .Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp))
                    .AutoFilter Field:=1, Criteria1:="<>"
                    With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                        For Each rng In .SpecialCells(xlCellTypeVisible).Cells
                            str = str & rng.Value & Chr(10)
                        Next rng
                    End With
                    .AutoFilter Field:=1
                End With
                wsI.Cells(Application.Match(.Name, wsI.Columns(2), 0), 3) = Left(str, Len(str) - 1)
            End If
            If .AutoFilterMode Then .AutoFilterMode = False
        End With
    Next ws

Safe_Exit:
    application.enableevents = true
    application.screenupdating = true
End Sub

I've collected together any statments found in column E and joined them with a CHr(10) (aka vbLF or line feed character).

This could be speeded up by turning off screen updating and enable events but it should run reasonably quick as is.

Upvotes: 1

Related Questions