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.

Usuwanie zawartości komórek z wyjątkiem niektórych;kopia arkusza aktywnego

kejt09 12 Lip 2018 11:16 168 10
  • #1 12 Lip 2018 11:16
    kejt09
    Poziom 3  

    Witam,
    borykam się z następującym problemem.
    Nagrałam makro do przycisku, które kopiuje arkusz (zawsze ten sam, nie ten aktywny - niestety). Po skopiowaniu arkusza następuje usunięcie wszystkich wprowadzonych danych, żeby znowu mieć pustą formatkę na nowy tydzień.
    Jak wprowadzić w tym kodzie warunek, żeby w danym zakresie czyściło zawartość ale z wyjątkiem komórek zawierających treść "ND"?
    I czy da się w prosty sposób przekształcić kod tak, aby kopiował się arkusz aktywny, a nie zawsze ten sam ?


    Code:
    Sub kopiuj_arkusz_czysty()
    
    '
    ' kopiuj_arkusz_czysty Makro
    '

    '
        Sheets("Przekazanie zmiany formatka").Select
        Sheets("Przekazanie zmiany formatka").Copy Before:=Sheets(1)
        Sheets("Przekazanie zmiany formatka (2").Select
        Range("G7:AA15").Select
        Selection.ClearContents
        Range("G17:AA22").Select
        Selection.ClearContents
        Range("G26:AA29").Select
        Selection.ClearContents
        Range("G32:AA37").Select
        Selection.ClearContents
        Range("B40:I47").Select
        Selection.ClearContents
        Sheets("Przekazanie zmiany formatka (2").Select
        Sheets("Przekazanie zmiany formatka (2").Name = "Przekazanie zmiany " & Format(Date, "dd-mm-yy")
    End Sub

    0 10
  • #3 12 Lip 2018 12:54
    kejt09
    Poziom 3  

    Dzięki, ale to nie zawiera warunku, który mówi o nie kopiowaniu komórek z zawartością o treści "ND"?

    0
  • Pomocny post
    #5 12 Lip 2018 20:56
    clubs
    Poziom 31  

    kejt09 napisał:
    Jak wprowadzić w tym kodzie warunek, żeby w danym zakresie czyściło zawartość ale z wyjątkiem komórek zawierających treść "ND"?

    Musisz te zakresy "przelecieć" pętlą :)
    Kod: vbscript
    Zaloguj się, aby zobaczyć kod


    ps
    jeżeli przypiszesz tą nazwę "intro" to wtedy
    Kod: vbscript
    Zaloguj się, aby zobaczyć kod

    0
  • #6 22 Sie 2018 09:50
    kejt09
    Poziom 3  

    Poradziłam sobie w taki sposób, ponieważ Wasze rozwiązania ciągle wywalały mi błędy:/

    Code:
    Sub CopySheet()
    


        ActiveSheet.Select
        ActiveSheet.copy Before:=ActiveSheet
        ActiveSheet.Select
       
       
       
        Range("G17:AA22").Select
        Selection.ClearContents
        Range("G32:AA37").Select
        Selection.ClearContents
        Range("B40:I47").Select
        Selection.ClearContents
       
        Range("G7:AA15,G26:AA29").Select
         
        For Each c In Range("G7:AA15,G26:AA29")
        If c.Value <> "ND" Then c.ClearContents
        Next c
       


        ActiveSheet.Select
        ActiveSheet.Name = "Przekazanie zmiany " & Format(Date, "dd-mm-yy")
       
       
    End Sub



    Teraz jednak chciałabym dodać tutaj makro, które będzie po skopiowaniu mojego arkusza i wyczyszczeniu go, kopiowało i wklejało "na sztywno" (jako wartość 123 w excelu) arkusze poprzednie (żeby pozbyć się z nich formuł - formuły są mi potrzebne tylko w aktywnym.

    Wiem, że mogę zacząć tak:

    Dim ws As Worsheet

    For Each ws In ThisWorkbook.Worksheets

    If ws.Name <> ThisWorkbook.ActiveSheet.Name Then

    i tutaj jakoś nie wiem xxxSheet.Select
    xxxSheet.Copy
    xxxSheet.Past

    Plus potrzebuję żeby to było wszystko w jednym przycisku (kopiowanie aktywnego arkusza + kopiowanie i wklejanie na sztywno zawartości poprzedniego)

    Ktoś poratuje?
    Pozdrawiam
    Kasia

    Dodano po 19 [minuty]:

    Dokładniej chodzi o to, żeby na sztywno skopiowało i wkleiło ten zakres komórek "Z2:AA2"

    Dodano po 10 [minuty]:

    Próbuję jakoś tak ale nie działa :/



    Code:
    Sub CopySheet()
    




    On Error GoTo MyError

        ActiveSheet.Select
        ActiveSheet.copy Before:=ActiveSheet
        ActiveSheet.Select
       
       
       
        Range("G17:AA22").Select
        Selection.ClearContents
        Range("G32:AA37").Select
        Selection.ClearContents
        Range("B40:I47").Select
        Selection.ClearContents
       
        Range("G7:AA15,G26:AA29").Select
         
        For Each c In Range("G7:AA15,G26:AA29")
        If c.Value <> "ND" Then c.ClearContents
        Next c
       


        ActiveSheet.Select
        ActiveSheet.Name = "Przekazanie zmiany " & Format(Date, "dd-mm-yy")
       
       
    Exit Sub

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
    Range("Z2:AA2").Select
    Range("Z2:AA2").copy
    Range("Z2:AA2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

    End If

    Next ws

    Exit Sub

    MyError:
        MsgBox "Uwaga w dniu dzisiejszym arkusz zostal juz utworzony"
     
     
     
    End Sub
     

    0
  • #7 22 Sie 2018 14:21
    lanzul
    Poziom 26  

    Jeśli chodzi o pierwszy wpis tematu i podane, przez kolegów powyżej, rozwiązania, to co może w nich nie działać ? Jaki błąd "wywala" ?
    Kod jest na tyle prosty, że raczej nie powinno być błędów ... można by do niego jeszcze dodać jakąś pułapkę błędu, sprawdzającą, czy dany arkusz już istnieje, np.:

    Kod: vba
    Zaloguj się, aby zobaczyć kod

    0
  • #8 22 Sie 2018 14:27
    kejt09
    Poziom 3  

    Nie działa, nie czyści zakresu w ogóle, zostawia wszystkie dane. Ale z tym już sobie poradziłam , tylko nie wiem jak ugryźć tą część z zapisywaniem na sztywno pozostałych arkuszy

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
    Range("Z2:AA2").Select
    Range("Z2:AA2").copy
    Range("Z2:AA2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    End If

    Next ws

    0
  • #9 22 Sie 2018 14:50
    lanzul
    Poziom 26  

    kejt09 napisał:
    Nie działa, nie czyści zakresu w ogóle, zostawia wszystkie dane
    :?:

    Zrzutka mp4 (na pewno odtwarza się z darmowym mpc-hc) z podglądem procedury.
    https://filmy.elektroda.pl/50_1534942023.mp4

    Co oznacza "zapisywaniem na sztywno pozostałych arkuszy" ? Czy chodzi o przekopiowanie formuł na ich wyniki, tak aby wartości się nie zmieniały ?

    0
  • #10 22 Sie 2018 14:54
    kejt09
    Poziom 3  

    Nie wiem, już usunęłam tamten kod , ale ciągle był jakiś problem, mój działa , więc jest OKEJ :)

    Tak dokładnie, tylko z zakresu komórek Z2:AA2 w arkuszach innych niż aktywny

    0
  • Pomocny post
    #11 22 Sie 2018 17:38
    clubs
    Poziom 31  

    kejt09 napisał:
    Tak dokładnie, tylko z zakresu komórek Z2:AA2 w arkuszach innych niż aktywny

    Kod: vbscript
    Zaloguj się, aby zobaczyć kod

    0