[jarekjarek]

Witam mam takie makro a chciałbym aby warunek If Range("M13").Value = 3 Then odnoszący się do komórki M13 sprawdzał wynik formuły w tej komórce lub tekst będący wynikiem a nie jak w tej chwili działa tylko wtedy gdy jest tam wpisana cyfra. Oraz jak zapisać kod przerywający wykonywanie makra gdy warunek nie jest spełniony

Sub MARZECkopia()

'
If Range("M13").Value = 3 Then
' KOPIUJE
Range("AE1").Copy
Range("AM10").Select
Selection.PasteSpecial Paste:=xlValues, Transpose:=False
Else
Range("L12").Value = "Chcesz skopiować niewłaściwy miesiąc"
End If
End Sub


Przydała by się też możliwość wyboru makrem arkuszy które objęte mają być kopiowaniem ale to przed kopiowaniem to znaczy najpierw wybieram arkusze sprawdzam warunek a potem kopiuje.

[Tajan]

[jarekjarek]

Dziękuję bardzo mi pomogłeś z tym zaznaczaniem arkuszy a reszty hmm polecenie If Range("M13").Value = 1.03 Then odwołuje sie do komórki M13 dalej nie działa jeżeli wynikiem jest pobrany z innej komórki zapis 1.03.

A napisz mi w jakiej formie wpisać do okienka wyboru arkuszy kilka okien do zaznaczenie mam 30 arkuszy

[Tajan]

[jarekjarek]

Z tym okienkiem to chodzi o to że w okienku wyszukiwanie danych mam w opisie

Podaj numer arkusza
1 - arkusz1
2 - arkusz2
3 - arkusz3

poniżej wpisuje np. numer 1 wybiera mi arkusz1 i wykonuje dalszą część makra

Ale jak wpisac w tym okienku wyboru arkusza aby mi wybrał wszystkie 3 arkusze od razu

[Tajan]

W przedstawionym makrze nie da się tego prosto zrobić. Konieczna jest jego dalsza rozbudowa w celu umożliwienia odczytu kilku wartości równocześnie, ewentualnie całkowita zmiana koncepcji i utworzenie własnego formularza, w którym wybór byłby realizowany za pomocą list lub pól wyboru.

[jarekjarek]

Tylko jak to zrobić ?

a może rezygnacja z wpisania numeru arkusza w tym makrze otworzy inne okno(składnia w tym makrze) które wybierze mi wszystkie wpisane w makrze arkusze.

To pozwoliło by wybierać pojedynczo lub wszystko

[Tajan]

Można, ewentualnie, pomysleć o takiej opcji, że wpisanie 0 wybiera wszystkie. Ale to też spora przeróbka makra.
Np. taki kod:

Kod:

Sub kopiujMarzecNowy() Dim arkusz          As String Dim nazwa           As String Dim pierwszy        As Integer Dim ostatni         As Integer Dim numer As Integer 'wybieramy arkusz podając numer arkusz = InputBox("Podaj numer arkusza:" & vbCrLf & _                   "1 - Arkusz1" & vbCrLf & _                   "2 - Arkusz2" & vbCrLf & _                   "3 - Arkusz3 " & vbCrLf & _                   "0 - Wszystkie " & vbCrLf, _                   "Kopiowanie danych") 'jeżeli naciśnięto Anuluj lub pusta wartość, to zakończ If arkusz = "False" Or arkusz = "" Then Exit Sub 'czy wpisano liczbę? If IsNumeric(arkusz) Then    'co wybrano?    If arkusz = "0" Then       'jezeli "0", to wszystkie       pierwszy = 1: ostatni = 3    Else       'jeżeli większa od zera, to jeden       pierwszy = Int(arkusz): ostatni = Int(arkusz)    End If     'pętla od pierwszego do ostatniego     For numer = pierwszy To ostatni         Select Case numer             Case 1: nazwa = "Arkusz1"             Case 2: nazwa = "Arkusz2"             Case 3: nazwa = "Arkusz3"             Case Else                 MsgBox "Podano błędny numer arkusza: " & numer                 nazwa = ""         End Select         If nazwa <> "" Then             'Aktywuj wybrany arkusz             Sheets(nazwa).Activate             'sprawdź warunek             If Range("M13").Value = 3 Then                 ' KOPIUJE                 Range("AE1").Copy                 Range("AM10").Select                 Selection.PasteSpecial Paste:=xlValues, _                                        Transpose:=False             Else                 'warunek niespełniony                 MsgBox "Chcesz skopiować niewłaściwy " & _                        "miesiąc na arkuszu " & nazwa             End If         End If     Next End If End Sub

[jarekjarek]

Witam !
Nie chce cie już męczyć i tak bardzo dużo mi pomogłeś DZIĘKUJĘ BARDZO !!!

Ale wiesz ja chciałbym kopiować dane co miesiąc z tych samych komórek ale do innego wiersza tzn. o wiersz niżej w kolejnym miesiącu ale w tych samych kolumnach aby to robić na tym makrze muszę ich zrobić 12(makr) na każdy miesiąc osobo. czy nie dało by się tego zrobić inaczej.
A polecenie If Sheets("Ustawienia").Range("M13").Value = 3 Then
sprawdza czy kopiuje właściwy miesiąc w tym przypadku 3 (marzec) w kolejnym musiało by sprawdzić 4 itd

Tak wygląda to makro teraz dla Marca w skrócie dla 3 osób ale ilość osób to sprawa dopisania ich

Kod:

Sub MARZECkopia() ' ' MARZECkopia ' Makro zarejestrowane 2007-02-08, autor Jarek ' ' Dim arkusz          As String Dim nazwa           As String Dim pierwszy        As Integer Dim ostatni         As Integer Dim numer As Integer 'wybieramy arkusz podając numer arkusz = InputBox("Podaj numer arkusza:" & vbCrLf & _                   "1 - Adamczewska" & vbCrLf & _                   "2 - Antkowiak" & vbCrLf & _                   "3 - Bednarek " & vbCrLf & _                   "0 - Wszystkie " & vbCrLf, _                   "Kopiowanie danych") 'jeżeli naciśnięto Anuluj lub pusta wartość, to zakończ If arkusz = "False" Or arkusz = "" Then Exit Sub 'czy wpisano liczbę? If IsNumeric(arkusz) Then    'co wybrano?    If arkusz = "0" Then       'jezeli "0", to wszystkie       pierwszy = 1: ostatni = 3    Else       'jeżeli większa od zera, to jeden       pierwszy = Int(arkusz): ostatni = Int(arkusz)    End If     'pętla od pierwszego do ostatniego     For numer = pierwszy To ostatni         Select Case numer             Case 1: nazwa = "Adamczewska"             Case 2: nazwa = "Antkowiak"             Case 3: nazwa = "Bednarek"             Case Else                 MsgBox "Podano błędny numer arkusza: " & numer                 nazwa = ""         End Select         If nazwa <> "" Then             'Aktywuj wybrany arkusz                     Sheets(nazwa).Activate             'sprawdź warunek             If Sheets("Ustawienia").Range("M13").Value = 3 Then ' KOPIUJE norme godzin Range("AE1").Copy Range("AM10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE Nadgodziny Range("Q40").Copy Range("AN10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE URLOP W Range("J44").Copy Range("AO10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("K44").Copy Range("AP10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE URLOP T Range("J45").Copy Range("AQ10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("K45").Copy Range("AR10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE CHOROBOWE C I CS Range("J46").Copy Range("AS10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("K46").Copy Range("AT10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE URLOP MACIERZYŃSKI M Range("O45").Copy Range("AU10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("P45").Copy Range("AV10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE OPIEKĘ Up K Range("O44").Copy Range("AW10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("P44").Copy Range("AX10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE OPIEKĘ Up K Range("J47").Copy Range("AY10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("K47").Copy Range("AZ10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE BADANIA OKRESOWE Bo Range("P47").Copy Range("BA10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE SZKOLENIA Sz Range("P46").Copy Range("BB10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE URLOP BEZPŁATNY B Range("T47").Copy Range("BC10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("U47").Copy Range("BD10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE Opb, U Range("T44").Copy Range("BE10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("U44").Copy Range("BF10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE WŻ Range("T46").Copy Range("BI10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False Range("U46").Copy Range("BJ10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE ŚWIĄTECZNE Range("L40").Copy Range("BK10").Select Selection.PasteSpecial Paste:=xlValues, Transpose:=False ' KOPIUJE NOCNE Range("P40").Copy Range("BL10").Select Selection.PasteSpecial Paste:=xlValues, _                                        Transpose:=False             Else                 'warunek niespełniony                 MsgBox "Chcesz skopiować niewłaściwy " & _                        "miesiąc na arkuszu " & nazwa             End If         End If     Next End If End Sub

[Tajan]

Można to zrobić na podobnej zasadzie wyboru. Ponizej masz makro, w którym najpierw wybierasz miesiąc a następnie arkusz. Dla większej przejrzystości rozbiłem to na trzy procedury. Główna to "kopiowanie", która uruchamia pozostałe. Przy okazji uprościłem również sposób kopiowania.

Kod:

Sub Kopiowanie() Dim miesiac As String Dim numer As Integer 'wybieramy miesiac podając numer miesiac = InputBox("Numer miesiąca:" & vbCrLf & _                   "1 - Styczeń" & vbCrLf & _                   "2 - Luty" & vbCrLf & _                   "3 - Marzec " & vbCrLf & _                   "4 - Kwiecień " & vbCrLf, _                   "Kopiowanie danych") 'jeżeli naciśnięto Anuluj lub pusta wartość, to zakończ If miesiac = "False" Or miesiac = "" Then Exit Sub 'czy wpisano liczbę? If IsNumeric(miesiac) Then    numer = Int(miesiac)    If numer > 0 And numer < 13 Then KopiujMiesiac numer End If End Sub Private Sub KopiujMiesiac(nrMies As Integer) Dim arkusz          As String Dim nazwa           As String Dim pierwszy        As Integer Dim ostatni         As Integer Dim numer As Integer 'wybieramy arkusz podając numer arkusz = InputBox("Podaj numer arkusza:" & vbCrLf & _                   "1 - Adamczewska" & vbCrLf & _                   "2 - Antkowiak" & vbCrLf & _                   "3 - Bednarek " & vbCrLf & _                   "0 - Wszystkie " & vbCrLf, _                   "Kopiowanie danych") 'jeżeli naciśnięto Anuluj lub pusta wartość, to zakończ If arkusz = "False" Or arkusz = "" Then Exit Sub 'czy wpisano liczbę? If IsNumeric(arkusz) Then    'co wybrano?    If arkusz = "0" Then       'jezeli "0", to wszystkie       pierwszy = 1: ostatni = 3    Else       'jeżeli większa od zera, to jeden       pierwszy = Int(arkusz): ostatni = Int(arkusz)    End If     'pętla od pierwszego do ostatniego     For numer = pierwszy To ostatni         Select Case numer             Case 1: nazwa = "Adamczewska"             Case 2: nazwa = "Antkowiak"             Case 3: nazwa = "Bednarek"             Case Else                 MsgBox "Podano błędny numer arkusza: " & numer                 nazwa = ""         End Select         If nazwa <> "" Then             'Aktywuj wybrany arkusz                     Sheets(nazwa).Activate             'sprawdź warunek             If Sheets("Ustawienia").Range("M13").Value = nrMies Then                 KopiujDane nrMies             Else                 'warunek niespełniony                 MsgBox "Chcesz skopiować niewłaściwy " & _                        "miesiąc na arkuszu " & nazwa             End If         End If     Next End If End Sub Private Sub KopiujDane(nrMies As Integer) 'kopiujemy do wiersza obliczonego na podstawie 'numeru miesiąca. Styczeń to wiersz 8 With Rows(7 + nrMies)     ' KOPIUJE norme godzin     'ma być AM1 ! to nie pomyłka     .Range("AM1") = Range("AE1")     ' KOPIUJE Nadgodziny     .Range("AN1") = Range("Q40")     ' KOPIUJE URLOP W     .Range("AO1") = Range("J44")     .Range("AP1") = Range("K44")     ' KOPIUJE URLOP T     .Range("AQ1") = Range("J45")     .Range("AR1") = Range("K45")     ' KOPIUJE CHOROBOWE C I CS     .Range("AS1") = Range("J46")     .Range("AT1") = Range("K46")     ' KOPIUJE URLOP MACIERZYŃSKI M     .Range("AU1") = Range("O45")     .Range("AV1") = Range("P45")     ' KOPIUJE OPIEKĘ Up K     .Range("AW1") = Range("O44")     .Range("AX1") = Range("P44")     ' KOPIUJE OPIEKĘ Up K     .Range("AY1") = Range("J47")     .Range("AZ1") = Range("K47")     ' KOPIUJE BADANIA OKRESOWE Bo     .Range("BA1") = Range("P47")     ' KOPIUJE SZKOLENIA Sz     .Range("BB1") = Range("P46")     ' KOPIUJE URLOP BEZPŁATNY B     .Range("BC1") = Range("T47")     .Range("BD1") = Range("U47")     ' KOPIUJE Opb, U     .Range("BE1") = Range("T44")     .Range("BF1") = Range("U44")     ' KOPIUJE WŻ     .Range("BI1") = Range("T46")     .Range("BJ1") = Range("U46")     ' KOPIUJE ŚWIĄTECZNE     .Range("BK1") = Range("L40")     ' KOPIUJE NOCNE     .Range("BL1") = Range("P40") End With End Sub

[jarekjarek]

Pieknie tylko ja mam 30 arkuszy a po case moge wpisać tylko 20kilka

Podam spis zaznaczonych arkuszy z rejestracji makra i proszę go wstawić zamiast wyboru arkuszy domyślnie niech zaznacza wszystkie

spis usunąłem ochrona danych :)

[Tajan]

Skoro mają być wszystkie, to można całkowicie zrezygnować z wybierania arkuszy przy pomocy nazw i kopiować wszystkie, "jak leci", oprócz arkusza "Ustawienia".

W porzednim przykładzie zamień procedurę KopiujMiesiac na poniższą:

Kod:

Private Sub KopiujMiesiac(nrMies As Integer) Dim arkusz          As Worksheet For Each arkusz In ActiveWorkbook.Worksheets         If arkusz.Name <> "Ustawienia" Then         'Aktywuj wybrany arkusz         arkusz.Activate         'sprawdź warunek         If Sheets("Ustawienia").Range("M13").Value = nrMies Then             KopiujDane nrMies         Else             'warunek niespełniony             MsgBox "Chcesz skopiować niewłaściwy " & _                    "miesiąc na arkuszu "             Exit Sub         End If     End If Next End If End Sub

[jarekjarek]

oprócz arkusza ustawienia mam jeszcze inne nie podlegające kopiowaniu :(

[Tajan]

Ile?

[jarekjarek]

11

próbuje sam podmienic arkusze do zaznaczenia na te moje ale nic mi nie wychodzi