Temat: VBA - makro - wielokrotne kopiowanie wiersza ze względu...

Witam,
zaczynam moją przygodę z VBA, do tej pory robiłem proste makra, ale teraz jest coś na czym utknąłem.

Mam listę produktów w kolumnach A:D; gdzie w kolumnie D mam podaną ilość.
Potrzebuję do nowego arkusza przekopiować całą tą listę, ale każdy wiersz potrzebuję aby kopiował się tyle razy ile wynosi ilość towaru w kolumnie D.
Dodatkowo w nowym arkuszu w kolumnie D potrzebuję aby ta ilość wynosiła 1 oraz aby w kolumnie E makro wypisywało kolejną liczbę porządkową.

Byłoby świetnie gdyby makro miało obsługę błędów, ponieważ czasem może się zdarzyć, że nie będzie danych w jakieś komórce w jednej z kolumn i taka linijka ma zostać przekopiowana bez zmian do osobnego arkusza, powiedzmy "błędne".

Excel z przykładem
https://www.dropbox.com/s/ugy109w4f9kiuum/podzial_zamow...

I tak przy okazji mam pytanie o jakiś dobry tutorial albo książkę do nauki?

Bardzo dziękuję za każdą pomoc.

Temat: VBA - makro - wielokrotne kopiowanie wiersza ze względu...

Chyba załączyłeś niepoprawny plik, bo nie znalazłem w nim ani grama Twojego kodu i informacji gdzie utknąłeś.

Temat: VBA - makro - wielokrotne kopiowanie wiersza ze względu...

Witam,
dziękuje za szybka odpowiedź. Trochę jeszcze próbowałem się znaleźć w googlu , aby rozwiązać mój problem. Wczoraj szło mi gorzej, dzisiaj już coś tam powstało.

Mam jednak pytanie odnośnie obsługi błędów. Czy jest jakiś prosty sposób na sprawdzanie czy w wierszu są puste komórki?
Bo ja myślałem, ponieważ mam tylko 4 kolumny, aby sprawdzać isEmpty w każdej komórce w kopiowanym wierszu i później dopiero wykonywać kolejne polecenia.

Bardzo proszę o zerknięcie na kod i proszę o uwagi, które pomogą mi u standaryzować kod i uczynić go bardziej "profesjonalnym"

Zapomniałem napisać, że specjalnie zaczynam od wiersza 7 ponieważ powyżej chciałem zrobić przyciski z funkcją kopiującą, czyszczącą i tą poniżej.

https://www.dropbox.com/s/ugy109w4f9kiuum/podzial_zamow...

Sub Zatowarowanie()



'

' kopia_linijka Makro

'



Dim i As Integer, lp As Integer

Dim ilosc As Integer



lp = 1

Sheets("Dane").Select



Do While WorksheetFunction.CountA(Range("A7:D7")) <> 0



    If (IsEmpty(Range("A7")) = True Or IsEmpty(Range("B7")) = True Or IsEmpty(Range("C7")) = True Or IsEmpty(Range("D7")) = True) Then

        

        Range("A7:D7").Select

        Selection.Copy

        Sheets("bledne").Select

        Range("A1").Select

        

            If IsEmpty(ActiveCell) Then

                ActiveCell.Offset(0, 0).Select

            Else

                If IsEmpty(ActiveCell.Offset(1, 0)) Then

                    ActiveCell.Offset(1, 0).Select

                Else

                    ActiveCell.End(xlDown).Offset(1, 0).Select

                End If

            End If

            

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

            

        Sheets("Dane").Select

        Rows("7:7").Select

        Selection.Delete Shift:=xlUp

        Range("A7").Select

        

    Else



    Sheets("Dane").Select

    Range("A7:D7").Select

    Selection.Copy

    

    i = Range("D7").Value

    

    For ilosc = 1 To i

      Sheets("Wynik").Select

      Range("A1").Select

      

            If IsEmpty(ActiveCell) Then

                ActiveCell.Offset(0, 0).Select

            Else

                If IsEmpty(ActiveCell.Offset(1, 0)) Then

                    ActiveCell.Offset(1, 0).Select

                Else

                    ActiveCell.End(xlDown).Offset(1, 0).Select

                End If

            End If

     

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

            :=False, Transpose:=False

        

        Selection.End(xlToRight).Value = 1

        Selection.End(xlToRight).Offset(0, 1).Value = lp

        lp = lp + 1

        

        

        Next ilosc

    

  

        Sheets("Dane").Select

        Rows("7:7").Select

        Selection.Delete Shift:=xlUp

        Range("A7").Select

        

    End If

    

Loop



MsgBox ("Zakończono działanie")

  

End Sub

Ten post został edytowany przez Autora dnia 20.10.16 o godzinie 12:28

Temat: VBA - makro - wielokrotne kopiowanie wiersza ze względu...

Aaaaa zapisałem plik, zamknąłem żeby wrzucić na dropboxa. Otwieram go jeszcze raz, a tam ani śladu po moim kodzie!!

Otwieram ten z dropboxa, a tam też nie ma kodu....

Dobrze, że wrzuciłem go tu na stronę.. Jak to się mogło stać?

Temat: VBA - makro - wielokrotne kopiowanie wiersza ze względu...

Jeżeli zapisujesz plik jako xlsx to trudno się dziwić, że tam kodu vba nie będzie.