Untitled

Sub KopiujJ2ZPodanychArkuszy_Procenty_Poprawione()
    Dim wsDocelowy As Worksheet
    Dim wsZrodlo As Worksheet
    Dim i As Integer
    Dim nazwaArkusza As String
    Dim wartosc As Variant
    
    ' Ustawienie arkusza docelowego (Podsumowanie)
    Set wsDocelowy = ThisWorkbook.Sheets("Podsumowanie") ' Zmień na właściwą nazwę

    ' Ustawienie zakresu wierszy do sprawdzenia
    i = 2 ' Zaczynamy od wiersza 2 (zakładamy, że nagłówki są w wierszu 1)
    
    ' Pętla po wierszach w kolumnie A
    Do While wsDocelowy.Cells(i, 1).Value <> ""
        nazwaArkusza = Trim(wsDocelowy.Cells(i, 1).Value) ' Pobranie nazwy arkusza i usunięcie spacji
        
        ' Sprawdzenie, czy arkusz o podanej nazwie istnieje
        On Error Resume Next
        Set wsZrodlo = ThisWorkbook.Sheets(nazwaArkusza)
        On Error GoTo 0
        
        ' Jeśli arkusz istnieje, kopiujemy wartość J2 do kolumny B
        If Not wsZrodlo Is Nothing Then
            wartosc = wsZrodlo.Range("J2").Val