[es] - Macro za copy/paste vrednosti iz jedne kolone u drugu (prvu slobodnu) kolonu

snenad_82
Nenad Stevanovic
Niš

Član broj: 126686
Poruke: 74
*.ninet.rs.

Profil

Macro za copy/paste vrednosti iz jedne kolone u drugu (prvu slobodnu) kolonu

^{19.02.2015. u 12:03 - pre 111 meseci}

Imam problem sa kreiranjem macroa (poznavanje VB ~0) koji će da kopira vrednosti iz jedne kolone i pastuje u sledeću slobodnu (januar, februar, mart...)
Worksheet će imati 31 sheet i nekih 2000 reda i potrebno mi je da to radi simultano po sheetovima.
Formirao sam skraćenu tabelu primera radi (dropbox link).
U mom primeru, vrednost se unosi u kolonu V a kreirana vrednost iz kolone E treba da se kopira u prvu slobodnu kolonu između H i T. Nadam se da mi možete pomoći i da sam solidno objasnio šta mi je potrebno.

https://dl.dropboxusercontent....96712159/kopiranje%20reda.xlsm

*Izmenio sam naslov jer sam primetio da je bio misleading

_{[Ovu poruku je menjao snenad_82 dana 20.02.2015. u 12:51 GMT+1]}

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
212.200.121.*

Sajt: www.gowi.rs

+109 Profil

Re: Macro za copy/paste vrednosti iz jedne kolone u drugu (prvu slobodnu) kolonu

^{20.02.2015. u 13:21 - pre 111 meseci}

Vidim iz priloga da si pokušao da snimiš makro, što je dobar početak. Tu možeš da vidiš kako se kodom odrađuje copy - paste. U tvom slučaju jedini problem je odrediti gde je sledeća prazna kolona tj. gde treba da se kopira.
Jedan kratak način je da krenemo od E5 (opseg koji se kopira) pa se sa End (xlToRight) pozicioniramo u poslednju popunjenu kolonu desno od posmatrane i onda se pozicioniramo još jednu kolonu desno Offset(ColumnOffset:=1)

Ceo makro bi mogao ovako

Code:
Option Explicit
Sub Popuni()
'
' Makro koji kopira  podatke iz kolone E
' U prvu slobodnu kolonu od H
'
' Keyboard Shortcut: Ctrl+l

'
Dim rngSrc As Range
Dim rngDest As Range
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E5:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
End Sub

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

snenad_82
Nenad Stevanovic
Niš

Član broj: 126686
Poruke: 74
*.ninet.rs.

Profil

Re: Macro za copy/paste vrednosti iz jedne kolone u drugu (prvu slobodnu) kolonu

^{23.02.2015. u 08:53 - pre 111 meseci}

Hvala na odgovoru. Uzeo sam slobodan vikend, pa se zbog toga nisam ranije javio.

Imam mali problem. Code radi odlično u slučaju kad je H kolona već popunjena. Kada nije ponaša se kao da u koloni G nema podataka kada je ona sakrivena. U slučaju da je rešenje komplikovano mogu da ukinem to kolonu.

I jedno pitanje. Kako da ga primenim na sve sheetove istovremeno, ubacio bih dugme u prvom sheetu.
Da li da ubacim red

Code:
Sheets("naziv sheet-a").Select

pa copy/paste Vašeg koda za sve sheetove koje imam?

Odgovor na temu

snenad_82
Nenad Stevanovic
Niš

Član broj: 126686
Poruke: 74
*.ninet.rs.

Profil

Re: Macro za copy/paste vrednosti iz jedne kolone u drugu (prvu slobodnu) kolonu

^{26.02.2015. u 09:44 - pre 111 meseci}

Prvo da se zahvalim Predragu na kodu, a evo i koda koji sam iskoristio prilagođen primeru, možda nekome zatreba.

Code:
Sub Popuni()
'
' Makro koji kopira  podatke iz kolone E
' U prvu slobodnu kolonu od H
'
' Keyboard Shortcut: Ctrl+l

'
Sheets("35").Select
Dim rngSrc As Range
Dim rngDest As Range
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E3:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
    Range("V5").Select
Sheets("38").Select
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E3:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
    Range("V5").Select
Sheets("39").Select
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E3:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
    Range("V5").Select
Sheets("43").Select
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E3:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
    Range("V5").Select
Sheets("158").Select
    ' Opseg koji se kopira
    Set rngSrc = ActiveSheet.Range("E3:E9")
    ' Gde da se kopira
    Set rngDest = rngSrc.End(xlToRight).Offset(ColumnOffset:=1)
    ' Kopiranje po vrednosti
    rngSrc.Copy
    rngDest.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' Finish copy/paste
    Range("V5").Select
Sheets("35").Select
Range("V5").Select
End Sub

Odgovor na temu