Kopiowanie zaznaczonych wierszy do nowego arkusza przez VBA


(Brunoo1) #1

Witam

 

Skrypt VBA  chciałbym wykorzystać do tworzenia wyceny na podstawie cennika.

 

Co jakiś czas od producenta dostaję cennik z nowymi warunkami handlowymi.

 

Na podstawie tego aktualnego cennika   Styczeń.xls  -posiada on 10 arkuszy  , chciałbym stworzyć nowy skoroszyt lub arkusz na wybrane pozycje z tych arkuszy.

 

 

Ten cennik zawsze ma wolną kolumnę A . Chciałbym po wpisaniu  ilości w kolumnie A , cały wiersz został przeniesiony z wpisaną ilością

 

Ogromnie prosze o pomoc nie wiem w jaki sposób do tego się zabrać.

 

wiem tylko jak się kod wprowadza do VBA  :slight_smile:

 

 


(Brech) #2

Poniżej podstawowe makro, które myślę pozwoli Ci zacząć:

Sub kopiujWiersze()

'wylaczanie przeliczania i auktualniania ekranu, zeby makro dzialalo szybciej'
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'----------------------------------------------------------------------------'

Dim arkusz, nowy As Worksheet
Dim i, k, j As Integer

i = 1
k = 0
j = 1

'petla po wszystkich arkuszach'
For Each arkusz In ActiveWorkbook.Sheets
            i = 1
            'za pierwszym razem dodaj nowy arkusz'
            If k = 0 Then
                Set nowy = Sheets.Add
                nowy.Name = "Arkusz" & Sheets.Count
                k = k + 1
            End If
            'przechodz po wierszach az kolumna B jest pusta'
            Do While arkusz.Range("B" & i).Value <> ""
                'jezeli kolumna A nie jest pusta to skopiuj ja do nowego arkusza, stworzone wczesniej'
                If arkusz.Range("A" & i).Value <> "" Then
                    arkusz.Rows(i).copy Destination:=nowy.Rows(j)
                    j = j + 1 'numeracja wierszy w nowym arkuszu'
                End If
                i = i + 1

            Loop
Next

'wlaczanie przeliczania i uaktualniania ekranu'
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'-----------------------------------------------'

End Sub

(StawikPiast) #3

Czyli szukasz kogoś kto ci to napisze. Nie ma problemu, kwestia ceny.