Pull data from multiple sheets macro

[pauldaddyadams]

Hi,

I was previously helped with a macro which would return data from sheets 1-6 if the row contained data (if it didn’t it was ignored).

Currently it is set up to pull data for only three months. This is defined by cells E5:G5 on the upload sheet e.g. if period 1 is in cell E5 then it would pull the rows which contain data on sheets 1 to 6 in the period 1 column.

I now need the macro below amended so that it pulls 12 months rather than 3 – how would it be ameneded?

Sub UploadData()
Dim TR, LR, LC1, LC2, LC3, Sum1, Sum2, Sum3, Wrow As Long
Dim Sh
Dim K As String

On Error Resume Next

LC1 = Sheets("1").Cells.Find(Sheets("Upload").Range("E5").Value).Column
LC2 = Sheets("1").Cells.Find(Sheets("Upload").Range("F5").Value).Column
LC3 = Sheets("1").Cells.Find(Sheets("Upload").Range("G5").Value).Column
Wrow = 6

For TR = 6 To 277
    
    For Each Sh In Worksheets
 If Sh.Cells(TR, "A") <> "" And Sh.Cells(TR, "G") <> "" Then
       If Sh.Name <> "Upload" And Sh.Name <> "Summary" Then
        Sum1 = Sh.Cells(TR, LC1).Value
        Sum2 = Sh.Cells(TR, LC2).Value
        Sum3 = Sh.Cells(TR, LC3).Value
        End If
    
    If Sum1 + Sum2 + Sum3 > 0 Then
        If Sum1 > 0 Then Sheets("Upload").Cells(Wrow, "E") = Sum1
        If Sum2 > 0 Then Sheets("Upload").Cells(Wrow, "F") = Sum2
        If Sum3 > 0 Then Sheets("Upload").Cells(Wrow, "G") = Sum3
    Sheets("Upload").Cells(Wrow, "B") = Sh.Cells(TR, "A")
    Sheets("Upload").Cells(Wrow, "C") = Sh.Cells(TR, "G")
    
    K = Trim(Sh.Cells(TR, "I"))
    Sheets("Upload").Cells(Wrow, "D") = Right(K, Len(K) - 7)
    Wrow = Wrow + 1
    K = ""
    End If
 End If
   
    Next Sh
    
    
Next TR
End Sub

[p24leclerc]

try this:

Public Sub test()
Dim Rng_Period As Range, Rng_Column As Long, I As Integer
Dim Sum1, Wrow, K, Sh As Worksheet, Tr
Sheets("Upload").Activate
Set Rng_Period = Range("E5", Cells(5, Columns.Count).End(xlToLeft))
Rng_Column = Sheets("1").Cells.Find(Rng_Period(1, 1).Value).Column
Wrow = 6
For Tr = 6 To 277
    
  For Each Sh In Worksheets
  
    If Sh.Cells(Tr, "A") <> "" And Sh.Cells(Tr, "G") <> "" Then
      If Sh.Name <> "Upload" And Sh.Name <> "Summary" Then
        For I = 1 To Rng_Period.Count
          Rng_Column = Sh.Cells.Find(Rng_Period(1, I).Value).Column
          Sum1 = Sh.Cells(Tr, Rng_Column).Value
          If Sum1 > 0 Then
            Sheets("Upload").Cells(Wrow, 4 + I) = Sum1
            K = Trim(Sh.Cells(Tr, "I"))
            Sheets("Upload").Cells(Wrow, "B") = Sh.Cells(Tr, "A")
            Sheets("Upload").Cells(Wrow, "C") = Sh.Cells(Tr, "G")
            Sheets("Upload").Cells(Wrow, "D") = Right(K, Len(K) - 7)
            K = ""
          End If
        Next
      End If
    End If
    If Sheets("Upload").Cells(Wrow, "B") <> "" Then Wrow = Wrow + 1
  Next Sh
    
    
Next Tr

End Sub