VBA Concatenate Range To Single Cell for Multiple Columns And Loop Over Multiple Sheets

[Gabba]

I'm trying to combine the contents of the 2nd through 5th cells in each column where any of the first 5 cells has something in them.

Ideally this could be applied to a list of worksheets (say SheetA, SheetB, SheetC). The worksheets are updated every 30mins from a web based table so I need to frequently repeat, hence the macro.

The number of columns in each worksheet is not the same but never exceeds 19 (Column S). I just applied my solution to all of the columns whether it was needed or not, since the resulting cell would be blank anyway. I'm sure there's a better way though.

I've spent hours trying to figure out how to do this and trying to adapt various solutions for different problems various posts.

I have working code but it's very cumbersome and I can see nightmares ahead if I need to make any slight changes.

The working code I have is for only one worksheet so it would multiply for every sheet I want to apply it to (approx 15)

I'm hoping someone can suggest a more elegant / simple solution. I have attempted to set up a For Each Column loop but I'm not really sure what I'm doing and can't get it to work.

Any help / suggestions would be greatly appreciated.

Thanks in advance.

Sub Prep()
    
    ThisWorkbook.Sheets("SheetA").Activate


    Range("A5").Value = Trim(Join(Application.Transpose(Range("A2:A5")), " "))
    Range("B5").Value = Trim(Join(Application.Transpose(Range("B2:B5")), " "))
    Range("C5").Value = Trim(Join(Application.Transpose(Range("C2:C5")), " "))
    Range("D5").Value = Trim(Join(Application.Transpose(Range("D2:D5")), " "))
    Range("E5").Value = Trim(Join(Application.Transpose(Range("E2:E5")), " "))
    Range("F5").Value = Trim(Join(Application.Transpose(Range("F2:F5")), " "))
    Range("G5").Value = Trim(Join(Application.Transpose(Range("G2:G5")), " "))
    Range("H5").Value = Trim(Join(Application.Transpose(Range("H2:H5")), " "))
    Range("I5").Value = Trim(Join(Application.Transpose(Range("I2:I5")), " "))
    Range("J5").Value = Trim(Join(Application.Transpose(Range("J2:J5")), " "))
    Range("K5").Value = Trim(Join(Application.Transpose(Range("K2:K5")), " "))
    Range("L5").Value = Trim(Join(Application.Transpose(Range("L2:L5")), " "))
    Range("M5").Value = Trim(Join(Application.Transpose(Range("M2:M5")), " "))
    Range("N5").Value = Trim(Join(Application.Transpose(Range("N2:N5")), " "))
    Range("O5").Value = Trim(Join(Application.Transpose(Range("O2:O5")), " "))
    Range("P5").Value = Trim(Join(Application.Transpose(Range("P2:P5")), " "))
    Range("Q5").Value = Trim(Join(Application.Transpose(Range("Q2:Q5")), " "))
    Range("R5").Value = Trim(Join(Application.Transpose(Range("R2:R5")), " "))
    Range("S5").Value = Trim(Join(Application.Transpose(Range("S2:S5")), " "))
    Rows(1).EntireRow.Delete
    Rows(1).EntireRow.Delete
    Rows(1).EntireRow.Delete
    Rows(1).EntireRow.Delete


End Sub

 

[Fluff]

How about

Sub Prep()
   Dim Col As Long
   Dim Shts As Variant
   Dim Sht As Variant
   
   Shts = Array("SheetA", "SheetB", "SheetC")
   For Each Sht In Shts
      With Sheets(Sht)
         For Col = 1 To 19
            .Cells(5, Col).Value = trim(Join(Application.Transpose(.Cells(2, Col).Resize(4)), " "))
         Next Col
         .Rows("1:4").Delete
      End With
   Next Sht
End Sub

 

[Gabba]

Sorry for how long it took to reply. I've been a bit ill.

Anyway, your solution worked a treat. Thank you so much

 

[Fluff]

Glad to help & thanks for the feedback.