Macro .. loop through sheets and collect informations and copy on the first page (like an register..)

[Lizz96]

Hello,



Im the new girl, in addition I have also a problem with a macro.. I hope you could help me..



The Idea behind is that the Macro is looping through all sheets in the workbook (names are always different) except the last one with the name “LAST”. Start is sheet “COLLECTION”

I want t grab from all other sheets some information and store them in “COLLECTION” in best case in addition start at “C20” currently its “A20” but I don’t know how to change the Cell value.

Here I would also like to do some hyperlinks out of the information in “COLLECTION” which have also the names form “D12”.



I know this sounds wired, but my English is not the best and I don’t know how to explain better J



Would really appreciate if some one could hook me up.. J



Thanks in advance,

Dim wkst As Worksheet

Dim row As Long

row = 20



For Each wkst In ActiveWorkbook.Worksheets



If wkst.Name <> "COLLECTION" Then

Worksheets("COLLECTION").Cells(row, 1) = wkst.Range("D9").Value & " - " & wkst.Range("D10").Value & " - " & wkst.Range("G9").Value & " - " & wkst.Range("G10").Value & " - " & wkst.Range("D12").Value & " - " & wkst.Range("D11").Value



row = row + 2



End If

Next

 

[mse330]

Welcome to Mr. Excel forum

Try below code ...

Sub test()

Dim ws As Worksheet, sh As Worksheet, r As Long
Set sh = Sheets("COLLECTION")
r = 20 'to start from row 20

For Each ws In Sheets
   If ws.Name <> "COLLECTION" Then
      With ws
         sh.Cells(r, "C") = Join(Array(.[D9], .[D10], .[G9], .[G10], .[D12], .[D11]), " - ")
         sh.Hyperlinks.Add sh.Cells(r, "C"), "", .[D12].Address(, , , True)
         r = r + 1
      End With
   End If
Next

End Sub

 

[Lizz96]

Thank you for your pretty nice code, this i will definitly keep as it looks much cleaner than my one..

Dim wkst As Worksheet
Dim row As Long
row = 20
For Each wkst In ActiveWorkbook.Worksheets
   If wkst.Name <> "COLLECTION" And wkst.Name <> "LAST" Then
      Worksheets("COLLECTION").Cells(row, 3) = wkst.Range("D9").Value & " - " & wkst.Range("D10").Value & " - " & wkst.Range("G9").Value & " - " & wkst.Range("G10").Value & " - " & wkst.Range("D12").Value & " - " & wkst.Range("D11").Value
       ActiveSheet.Hyperlinks.Add Anchor:=Cells(row, 3), Address:="", SubAddress:="'" & wkst.Name & "'!A1", TextToDisplay:=wkst.Range("D9").Value & " - " & wkst.Range("D10").Value & " - " & wkst.Range("G9").Value & " - " & wkst.Range("G10").Value & " - " & wkst.Range("D12").Value & " - " & wkst.Range("D11").Value
      row = row + 2
   End If
Next

 

[Lizz96]

One difference i cant understand, when i use your macro it position in the sheet is always fixed on "D12", when i use mine, it always goes back to "A1".

 

[mse330]

Because this is what have written in your code ... Check the highlighted in red part below in your code

SubAddress:="'" & wkst.Name & "'!A1"

 

[Lizz96]

Yes, this part i understand :D the question would be more less, how could i archiv this in our awesome code?

 

[Lizz96]

Some times i feel even more stupid Thank you very much..

sh.Hyperlinks.Add sh.Cells(r, "C"), "", .[A1].Address(, , , True)