[Excel, VBA] Kopiowanie w zależności od zawartości komórki

Dla specjalistów Programowanie
#1

Witam.

Bardzo proszę o pomoc.

Chciałbym uzyskać skrypt, który kopiował by zakres komórek w danej kolumnie od jej początku do wiersza, w którym znajduje się dana wartość (np “Koniec”)

Przykład:

W kolumnie A znajdują się wartości lub też tekst. Załóżmy, że w komórce A31 znajduje się tekst “Koniec”. Chciałbym aby skrypt skopiował mi wszystko z zakresu A1:A31. Oczywiście chodzi o to że wartość ta może zmieniać swoje położenie w kolumnie A.

Mam nadzieje, że opisałem to zrozumiale;)

Pozdrawiam.

#2 
Dim i As Integer

Dim j As String


i = 1

j = "koniec" 'lub inny tekst do szukania


While Cells(i, 1) <> j

i = i + 1

Wend


Range(Cells(1, 1), Cells(i - 1, 1)).Select 'Zaznacza wszystko z zakresu oprócz komórki z 'koniec'

Selection.Copy 'Kopiuje zaznaczenie


'Napisałeś, że chodzi o kopiowanie, jeśli ma być skopiowane do schowka to dalej możesz pominąć

Cells(1, 2).Select 'Ustawiasz gdzie ma być skopiowane

ActiveSheet.Paste 'Wklejasz
#3

Dzięki za pomoc:)

Jest jednak jeszcze jedna sprawa…

Chodzi o to, że ja bym chciał aby on tego szukał w innym arkuszu i kopiował z tego przeszukiwanego arkusza.

Sam zrobiłem coś takiego:

Private Sub CommandButton1_Click()


Dim i As Integer

Dim j As String


i = 1

j = "koniec"


While Arkusz2.Cells(i, 2) <> j

i = i + 1

Wend


Range(Cells(1, 2), Cells(i - 1, 2)).Select 

Selection.Copy


End Sub

… i rzeczywiście szuka w tym arkuszu lecz kopiuje już z tego, w którym “działam”. Próbowałem dawać

Worksheets("Arkusz2").Range(Cells(1, 2), Cells(i - 1, 2)).Select

…lecz wyrzuca błąd "Run-time error ‘1004’ "

#4

Kombinujecie… :wink:

Kopiuje z

Workbooks( “zeszyt1” ).Worksheets( “arkusz1” )

do

Workbooks( “zeszyt2” ).Worksheets( “arkusz1” )

Dopasuj sobie nazwy źródła i celu, w razie czego pytaj :slight_smile:

Sub kopiowanie()


For i = 1 To Workbooks("zeszyt1").Worksheets("arkusz1").[a1].End(xlDown).Row

    If Range("a" & i).Value = "Koniec" Then

        Workbooks("zeszyt2").Worksheets("arkusz1").Range("a1", "a" & i) = Range("a1", "a" & i).Value

        Exit Sub

    End If

Next i


End Sub

lub wersja z kopiowanie poformatowanych komórek

Sub kopiowanie()


For i = 1 To Workbooks("zeszyt1").Worksheets("arkusz1").[a1].End(xlDown).Row

    If Range("a" & i).Value = "Koniec" Then

        Range("a1", "a" & i).Copy

        Workbooks("zeszyt2").Worksheets("arkusz1").Paste

        Application.CutCopyMode = False

        Exit Sub

    End If

Next i


End Sub
#5

Hm… niestety, ale nie działa. “Workbooks(“zeszyt1”)” jako “zeszyt1” trzeba wpisać nazwę pliku, w którym znajduje się arkusz? Jeżeli tak, to zrobiłem tak i mimo to nie działa.

Może wyjaśnię jeszcze raz o co mi chodzi.

W Arkuszu1 mam przycisk po którego naciśnięciu chcę aby mi skopiował wszystko z Arkusza2 z kolumny A aż do momentu wystąpienia tekstu “Koniec”. Kopiowanie ma odbyć się do schowka.

To co napisał kolega Qoo działa, lecz nie wiem jak mu zadać komendy, aby kopiował z innego arkusza.

#6

terbit, w excelu zaznaczasz rejestruj makro, kopiujesz ręcznie kawałek dowolnego rozmiaru. ale z odpowiedniego miejsca do odpowiedniego miejsca, kończysz rejestracje, otwierasz zapisane makro i trochę go korygujesz.

#7

ok, teraz chyba już wiem co miałeś na myśli, przeróbka z kopiowaniem do schowka poniżej

Sub kopiowanie()


    For i = 1 To Sheets("arkusz2").Range("a1").End(xlDown).Row

        If Sheets("arkusz2").Range("a" & i).Value = "Koniec" Then

            Sheets("arkusz2").Range("a1", "a" & i).Copy

            Exit Sub

        End If

    Next i


End Sub

Jak chcesz, to prześlij mi plik excelowski na maila, to wstawię odpowiednie makro. W razie czego pisz na PW i podam maila.

#8

alchemik… działa! :wink: Dzięki wielkie;)