Wpis liczby, połączenie danych z kolumny do wiersza

Witam
Mam takie makro, które po wpisaniu liczby w komórce przenosi dane z wiersza 9 do odpowiedniej kolumny 9.

Sub Makro(Wiersz As Long)

  Dim i             As Byte
  Dim zakres        As String
  Dim Ile           As Byte
  Dim j             As Byte

Select Case Range("AD3").Value  'warunki dla oznaczeń upraw w RS dla komórki AD3
Case 1  'pierwszy warunek
  On Error Resume Next 'chyba nie będzie potrzebne :-)
Ile = Application.WorksheetFunction.CountA(Range(Cells(Wiersz, "AG"), Cells(Wiersz, "HZ")))

  For i = 33 To 234   'kolumny arkusza od AG do HZ
    If Cells(Wiersz, i).Value <> "" Then
        If Cells(3, AD) = 0 Then
            If Cells(11, i).Value = "RS," Then
                If Not IsNumeric(Right(Cells(9, i), 1)) Then
        zakres = zakres & Cells(9, i).Value & ", "
      j = j + 1
                End If
            End If
         End If
    End If
    If j = Ile Then Exit For
  Next i
   Application.EnableEvents = False
 
 Case 2 'drugi warunek
  On Error Resume Next 'chyba nie będzie potrzebne :-)
Ile = Application.WorksheetFunction.CountA(Range(Cells(Wiersz, "AG"), Cells(Wiersz, "HZ")))

  For i = 33 To 234   'kolumny arkusza od AG do HZ
    If Cells(Wiersz, i).Value <> "" Then
        If Cells(3, AD) = 1 Then
            'If Cells(11, i).Value = "RS," Then
                If Not IsNumeric(Right(Cells(9, i), 1)) Then
        zakres = zakres & Cells(9, i).Value & ", "
      j = j + 1
                End If
            'End If
         End If
    End If
    If j = Ile Then Exit For
  Next i
   Application.EnableEvents = False
   
   End Select
   
  If Len(zakres) > 1 Then
    Cells(Wiersz, 9).Value = Left(zakres, Len(zakres) - 2) 'usuwam końcowy przecinek
  Else
    Cells(Wiersz, 9).ClearContents
  End If
 
  Application.EnableEvents = True
 
  On Error GoTo 0
End Sub
i dodatkowo chcę, aby to makro łączyło mi dane z kolumny 6 (nr działki) i przenosiło je do wiersza 1 od komórki AG1 do HZ1 dla wartości większych od zera wpisywanych w komórkach AG20 do HZ448, jednocześnie pomijając wiersz kolorem niebieskim, czyli łącząc dane z co drugiego wiersza od wiersza 20.
Próbowałem różnych metod, ale w makrach jestem jeszcze cienki.

zanotowane.pl

doc.pisz.pl

pdf.pisz.pl

katkaras.opx.pl