Transfer data to database sheet from multiple worksheet of the same workbook

Question

I wan't to transfer data within a range from each worksheet of a workbook excluding specific worksheet names based on a value being greater than zero within a range. Based on the value being greater than zero I wan't to transfer corresponding column values in the same row and update the database sheet by putting the values under specific columns from all worksheets apart from specific sheet and populate the list in the database sheet. My code does not seem to be working.

 Sub Button4_Click()

   Dim sourceRng As Range
   Dim cell As Range
   Dim i As Long
   Dim ws As Worksheet
   Dim wsC As Worksheet

    Set wsC = Sheets("Database")
   For Each wkSht In ThisWorkbook.Worksheets
     If ws.Name <> "Database" And ws.Name <> "Combine" And ws.Name <> "CETIN" Then
    Set sourceRng = ActiveSheet.Range("AY17:AY30")
    i = 1
    For Each cell In sourceRng
     If cell.Value > 0 Then
      cell.Resize(1, 1).Copy Destination:=wsD.Range("A" & i)
      i = i + 1
     End If
     Next cell
    End If
    Next
 End Sub

Answer 1

I believe this should work for you. Your image is hard to read, so you may need to adjust the columns if I read them wrong.

Option Explicit
Sub Button4_Click()
    Dim i As Long
    Dim wkSht As Worksheet
    Dim wsC As Worksheet
    Dim rowCount As Integer
    Dim nextEmptyRow As Integer

    Set wsC = ThisWorkbook.Worksheets("Database")
    For Each wkSht In ThisWorkbook.Worksheets
        nextEmptyRow = wsC.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If wkSht.Name <> "Database" And wkSht.Name <> "Combine" And wkSht.Name <> "CETIN" Then
            For i = 17 To 30
                If wkSht.Range("AY" & i).Value > 0 Then
                    wkSht.Range("AY" & i).Copy Destination:=wsC.Range("A" & nextEmptyRow)
                    wkSht.Range("K" & i).Copy Destination:=wsC.Range("B" & nextEmptyRow)
                    wkSht.Range("R" & i).Copy Destination:=wsC.Range("C" & nextEmptyRow)
                    wkSht.Range("T" & i).Copy Destination:=wsC.Range("D" & nextEmptyRow)
                End If
            Next i
        End If
    Next wkSht
 End Sub

You can also replace wkSht.Range("AY" & i).Copy Destination:=wsC.Range("A" & nextEmptyRow) with wsC.Range("A" & nextEmptyRow).value = wkSht.Range("AY" & i).value for those 4 lines if you only want to preserve the value and not formatting.