Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Makro - kopiowanie -kolumny - Kopiowanie całego arkusza dla wybranych kolumn

kemil 13 Wrz 2017 13:52 483 7
  • #1 13 Wrz 2017 13:52
    kemil
    Poziom 10  

    Witam serdecznie
    Chciałbym przerobić poniższe makro tak by kopiowało ono cały arkusz do nowego tam gdzie w pierwszym wierszu dla kolumny jest słowo "Tak"
    Korzystam z makra który kopiuje wybrane wiersze, tzn jeśli w kolumnie A jest wartość "Tak"
    Gorąca prośbą o pomoc w przerobieniu makra

    Sub kopiuj_do_nowego_pliku()
    Dim x&, y&, last_row&, wks As Worksheet, wkb As Workbook
    Set wks = ActiveSheet
    Set wkb = Workbooks.Add
    last_row = wks.Cells(wks.Rows.Count, "a").End(xlUp).Row
    Application.ScreenUpdating = False
    For x = 1 To last_row
    If wks.Cells(x, "a") = "Tak" Then
    y = y + 1
    wks.Rows(x).Copy wkb.Sheets(1).Rows(y)
    End If
    Next x
    Application.ScreenUpdating = True
    End Sub

    0 7
  • #2 13 Wrz 2017 15:23
    JRV
    Specjalista - VBA, Excel

    kemil napisał:
    w pierwszym wierszu dla kolumny jest słowo "Tak"

    Dla tego trzeba jedna linijka
    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #3 14 Wrz 2017 08:18
    kemil
    Poziom 10  

    JRV napisał:
    kemil napisał:
    w pierwszym wierszu dla kolumny jest słowo "Tak"

    Dla tego trzeba jedna linijka
    Kod: vb
    Zaloguj się, aby zobaczyć kod


    Może nie doprecyzowałem
    chciałbym aby kopiował dla n kolumn tzn a1,b,1c1....=Tak
    nie tylko gdy w A1=Tak

    Dodano po 10 [godziny] 54 [minuty]:

    Jeszcze inaczej,
    chciałbym skopiować do nowego arkusza te kolumny dla których w pierwszym wierszu kolumny było słowo Tak
    Kopiowanie do nowego arkusza bez zachowania położenia kolumn, tzn doklejane w prawo kolumny

    0
  • #4 15 Wrz 2017 22:27
    kemil
    Poziom 10  

    kemil napisał:
    JRV napisał:
    kemil napisał:
    w pierwszym wierszu dla kolumny jest słowo "Tak"

    Dla tego trzeba jedna linijka
    Kod: vb
    Zaloguj się, aby zobaczyć kod


    Może nie doprecyzowałem
    chciałbym aby kopiował dla n kolumn tzn a1,b,1c1....=Tak
    nie tylko gdy w A1=Tak
    Dodano po 10 [godziny] 54 [minuty]:
    Jeszcze inaczej,
    chciałbym skopiować do nowego arkusza te kolumny dla których w pierwszym wierszu kolumny było słowo Tak
    Kopiowanie do nowego arkusza bez zachowania położenia kolumn, tzn doklejane w prawo kolumny


    Mam coś takiego
    Ale mam problem z zapętleniem tego, kopiuje mi tylko jedną "pierwszą" kolumnę gdzie w pierwszym wierszu tek kolumny jest wartość "1" Jak to zapętlić by kopiował wszystkie kolumny dla wartości z wiersza pierwszego = 1? Prośba o pomoc
    kod:
    Sub Wybor()
    ow = ActiveSheet.UsedRange.Rows.Count
    ok = ActiveSheet.UsedRange.Columns.Count
    For y = 1 To ok
    kolumna = ActiveSheet.Cells(1, y).Value
    If kolumna = 1 Then
    Sheets("Arkusz1").Select
    ActiveSheet.Range(Cells(2, y), Cells(ow, y)).Select
    Selection.Copy
    Sheets("Arkusz2").Select
    ActiveSheet.Cells(1, y).Select
    ActiveSheet.Paste
    End If
    Next y
    End Sub

    0
  • #5 15 Wrz 2017 22:42
    JRV
    Specjalista - VBA, Excel

    Po zakończeniu kopiowania nie jest zwracania na pierwszy arkusz

    0
  • #6 15 Wrz 2017 22:46
    kemil
    Poziom 10  

    JRV napisał:
    Po zakończeniu kopiowania nie jest zwracania na pierwszy arkusz

    Mógłby prosić o rozwiązanie jak to zrobić ? Niestety chyba nie wymyślę

    0
  • #7 15 Wrz 2017 22:49
    JRV
    Specjalista - VBA, Excel

    Po
    ActiveSheet.Paste
    wpisz
    Sheets("Arkusz1").Select

    0
  • #8 15 Wrz 2017 22:54
    kemil
    Poziom 10  

    Dziękuje działa , właśnie to zrobiłem

    0
  Szukaj w 5mln produktów