Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Usuwanie zbędnych wierszy, automatyczna nazwa nowego arkusza

chiptip1 · Świeżak Wersja: Win Office 2019 Posty: 5

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 29 raz(y) 11.21 KB

Plik wynikowy - Sernik - Impreza Jarka - dzisiejsza data.xlsx

Pobierz Plik ściągnięto 31 raz(y) 11.74 KB

umiejead · 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 31 raz(y) 25.85 KB

chiptip1 · Świeżak Wersja: Win Office 2019 Posty: 5

umiejead - jesteś WIELKI.

Dziękuję!!

sp3wbe · 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 28 raz(y) 30.82 KB

umiejead · 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.
.

chiptip1 · Świeżak Wersja: Win Office 2019 Posty: 5