Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Excel makro - Kopiowanie komórek do sąsiedniego arkusza pod warunkiem

gertan 21 Wrz 2014 14:48 1248 1
  • #1 21 Wrz 2014 14:48
    gertan
    Poziom 9  

    Witam,

    Mam problem z makrem, które znalazłem na forum i które staram się przerobić pod moje potrzeby. Docelowo, makro ma sprawdzać czy w komórce w kolumnie F arkusza 1 jest wyraz "tak" i jeżeli to się potwierdzi to kopiować w pierwsze wolne miejsce w kolumnie D akrusza 2 zawartość komórki B arkusza 1. I jednocześnie usuwać ten wiersz z arkusza 1.

    Poniżej to co udało mi się przerobić na obecną chwilę. Oczywiście nie działa :)

    Code:
    Sub ddd() 
    


        Dim OstW As Long
        Dim kom As Excel.Range

        Application.ScreenUpdating = False

        With Sheets("Arkusz1")
            OstW = .Cells(Rows.Count, "F").End(xlUp).Row

            For Each kom In .Range("F4:F" & OstW)
                If kom.Value = "tak" Then
                    Range("B4:B").Copy
                   
                    With Sheets("Arkusz2")
                        Range("D5:D").PasteSpecial
                        Paste = xlPasteValues
                       
                    End With
                   
                    .Rows(kom.Row).Delete
                End If
            Next kom

        End With

        Application.ScreenUpdating = True

    End Sub

    0 1
  • #2 21 Wrz 2014 20:53
    JRV
    Specjalista - VBA, Excel

    Witaj

    Code:

    Sub ddd()

        Dim OstW As Long
        Dim kom As Excel.Range

        Application.ScreenUpdating = False
        With Sheets("Arkusz1")
            OstW = .Cells(Rows.Count, "F").End(xlUp).Row
            For Each kom In .Range("F4:F" & OstW)
                If kom.Value = "tak" Then
                    Range("B" & kom.Row).Copy
                    Sheets("Arkusz2").Cells(Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial xlValues
                    .Rows(kom.Row).Delete
                End If
            Next kom
        End With
        Application.ScreenUpdating = True

    End Sub

    0
  Szukaj w 5mln produktów