Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Wytnij i wklej w makrze
toja




Typ: neutral
Postów: 31
Zarejestrowany: Apr 2005
Wytnij i wklej w makrze

Mam Arkusz z zakresem komórek A10:AA100. Chciałbym, aby wartość jaka jest w  aktywnej komórce po użyciu makra została wycięta i następnie wklejona do komórki np w wierszu 150 w tej samej kolumnie.Jeżeli by nastąpila  sytuacja że należało by wyciąć wartość z tej samej kolumny ale z innego wiersza i ponownie wkleić to wtedy nastąpilo by to do wiersza 151 tej samej kolumny poprostu "oczko niżej"
Komórki mają różne wartości liczby i litery


--------------------------------------------------
Pozdrawiam Marian

09-05-2005 18:39
Pokaż profil toja  Wyślij email do toja   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003


i = 150

ActiveCell.Copy

Do While Thisworkbook.Worksheets("nazwa".Range("A" & i) <> ""
    i = i +1
Loop

Thisworkbook.Worksheets("nazwa".Range("A" & i).PasteSpecial xlPasteValues




_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

11-05-2005 21:46
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
toja




Typ: neutral
Postów: 31
Zarejestrowany: Apr 2005

Wydaje mi się ,że źle sprecyzowałem swoje pytanie

Poprawnie działa to dla kolumny A, ale jak przejdę do kolumny np D i pobiorę wartości to są one przenoszone też do kolumny A, a powinny się znaleźc w kolumnie D itd .

I dlaczego metoda PasteSpecial działa przy
ActiveCell.Copy, a nie działa przy ActiveCell.Cut

------------------------------------

Pozdrawiam Marian

12-05-2005 08:31
Pokaż profil toja  Wyślij email do toja   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003


Sub MojeKopiuj()
Dim i as Long
Dim iKol as Long

i = 150
iKol = ActiveCell.Column
ActiveCell.Copy

Do While Thisworkbook.Worksheets("nazwa".Cells(i, iKol) <> ""
    i = i +1
Loop

Thisworkbook.Worksheets("nazwa".Cells(i, iKol).PasteSpecial xlPasteValues
End Sub


Cut i Copy działa nawet dla ActiveCell


_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

12-05-2005 18:10
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
toja




Typ: neutral
Postów: 31
Zarejestrowany: Apr 2005

Jeżeli chodzi o kopiowanie i wklejanie zawartości komórki to jest bezbłędnie, natomiast jeżeli chcę wyciąć zawartość komórki i ActiveCell.Copy zmienię na ActiveCell.Cut, to pojawia się błąd
Czy zmiana kodu musi jeszcze nastąpić w innym miejscu?

-----------------------------------------
Pozdrawiam Marian

13-05-2005 08:19
Pokaż profil toja  Wyślij email do toja   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003

NIe wiem, bo u mnie chodzi bez zarzutu.


_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

13-05-2005 22:43
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003

Spróbuj tego, powinno działać

Sub MojeKopiuj()
Dim i As Long, iKol As Long, poz As Long
Dim rng As Range, sAddress As String

On Error GoTo Err_MojeKopiuj

i = 150
Set rng = ActiveCell
iKol = rng.Column
sAddress = rng.Address

If rng.Row >= i Then Exit Sub

rng.Copy

Do While ActiveSheet.Cells(i, iKol) <> ""
    i = i + 1
Loop

Do
    poz = InStr(poz + 1, sAddress, "$"
    If poz = 0 Then Exit Do
    iKol = poz
Loop

sAddress = Left(sAddress, iKol) & i
ActiveSheet.Range(sAddress).PasteSpecial xlPasteValues
rng.ClearContents

Exit_MojeKopiuj:
    On Error Resume Next
    Set rng = Nothing
    Exit Sub
   
Err_MojeKopiuj:
    MsgBox Err.Description, vbInformation, Err.Number
    Resume Exit_MojeKopiuj
End Sub




_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

14-05-2005 11:42
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
toja




Typ: neutral
Postów: 31
Zarejestrowany: Apr 2005

Tak,nic dodać nic ująć
Dziękuję
----------------------------------------
Pozdrawiam Marian

14-05-2005 22:38
Pokaż profil toja  Wyślij email do toja   
Wszystkich odpowiedzi: 7 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1