Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 72857 Skopiuj do schowka Usuwanie zbędnych wierszy, automatyczna nazwa nowego arkusza
Autor Wiadomość
chiptip1 
Świeżak


Wersja: Win Office 2019
Posty: 5
Wysłany: 23-05-2022, 07:03   Usuwanie zbędnych wierszy, automatyczna nazwa nowego arkusza

Witajcie,

Mam bazowy plik "Składniki.xlsx".
Zależy mi na stworzeniu makro, które usunie wszystkie wiersze, dla których wartość w kolumnie B=0.
A na koniec zapisze nowopowstały plik wg zasady: "Plik wynikowy - komórka B2 - dzisiejsza data.xlsx".

Z góry dziękuję za każdą pomoc!

Składniki.xlsx
Pobierz Plik ściągnięto 13 raz(y) 11.21 KB

Plik wynikowy - Sernik - Impreza Jarka - dzisiejsza data.xlsx
Pobierz Plik ściągnięto 17 raz(y) 11.74 KB

_________________
Pozdrawiam
Marcin
ID posta: 417412 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 976 razy
Posty: 5298
Wysłany: 23-05-2022, 09:17   

1. Ponieważ makro przerabia oryginalny plik (a konkretnie Arkusz1) - zrobiłem kopię oryginalnego arkusza - tak żeby zawsze móc go skopiować i powtórzyć / prześledzić / zmodyfikować makro.
2. Datę do nazwy pliku wziąłem z kom. H1.
3. Nowy plik tworzy się w tym samym katalogu co plik źródłowy.
4. Mimo że plik źródłowy ma format .xlsm - to wynikowy będzie bez pytania w formacie .xlsx. Ale uwaga: plik wynikowy się nadpisze - ale tylko wtedy gdy będzie zamknięty. Inaczej kod się zbuntuje.
5. Nie sprawdzałem poprawności obliczeń cen / wartości.

Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim i&, d&
Dim nazwa$, sciezka$

If Range("A3").Value <> "" Then
    MsgBox "Tem plik jest już chyba przetobiony!", vbExclamation, "Info"
    Exit Sub
End If

Cells(1, 2).Value = Cells(1, 2).Value & " - " & _
    Cells(3, 2).Value & " _ " & Cells(1, 8).Value

Rows("2:4").EntireRow.Delete


d = Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

For i = d To 4 Step -1
    If Cells(i, 2).Value = "" Then Rows(i).EntireRow.Delete
Next i

Range("A1").Select

Application.ScreenUpdating = True

nazwa = Range("B1").Value
sciezka = ThisWorkbook.Path

ThisWorkbook.ActiveSheet.Copy

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs sciezka & "\" & nazwa & ".xlsx"

Application.DisplayAlerts = True

End Sub


Kopia Składniki.xlsm
Pobierz Plik ściągnięto 14 raz(y) 25.85 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 417418 Skopiuj do schowka
 
 
chiptip1 
Świeżak


Wersja: Win Office 2019
Posty: 5
Wysłany: 23-05-2022, 09:40   

umiejead - jesteś WIELKI.

Dziękuję!!
_________________
Pozdrawiam
Marcin
ID posta: 417419 Skopiuj do schowka
 
 
sp3wbe 
Stały bywalec Excelforum


Wersja: Win Office 2016
Pomógł: 56 razy
Posty: 314
Wysłany: 23-05-2022, 10:23   

Witaj
Poszedłem nieco inną drogą. W "Arkusz2" są wyodrębnione produkty i dalej zapisywane do PDF w tym samym katalogu w którym jest plik excela. Potem możesz zmienić dane w "Arkusz1" i tworzyć następny PDF

Pozdrawiam

Składnik.xlsm
Pobierz Plik ściągnięto 14 raz(y) 30.82 KB

_________________
Tadek
ID posta: 417421 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 976 razy
Posty: 5298
Wysłany: 23-05-2022, 11:10   

Jedna uwaga:

W tytule:
Cytat:
Usuwanie zbędnych wierszy, automatyczna nazwa nowego arkusza
vs. w treści:
Cytat:
A na koniec zapisze nowopowstały plik

Trzymałem się treści.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 417426 Skopiuj do schowka
 
 
chiptip1 
Świeżak


Wersja: Win Office 2019
Posty: 5
Wysłany: 23-05-2022, 11:34   

umiejead napisał/a:
Jedna uwaga:

W tytule:
Cytat:
Usuwanie zbędnych wierszy, automatyczna nazwa nowego arkusza
vs. w treści:
Cytat:
A na koniec zapisze nowopowstały plik

Trzymałem się treści.
.


Mój błąd, wybaczcie.
Miałem na myśli nowy plik, czyli to, co napisałem w treści.
Bąd w tytule...

Sorki za zamieszanie.
_________________
Pozdrawiam
Marcin
ID posta: 417427 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.wip.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe