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

Excel proste makro do rejestrowania umów

12 Sie 2011 12:14 3703 4
  • Poziom 10  
    Witam serdecznie

    W excelu zrobiłem sobie formularz umowy, połączony z bazą osobową, rachunkami i oświadczeniami. Wisienką na torcie byłoby, gdyby jeszcze w osobnym arkuszu prowadził sie rejestr tych umów. Zrobiłem w VBA prostą formułę, żeby mi archiwizowało z poszczególnych komórek formularza dane, ale niestety jest to w jednym wierszu i zaciąlem się żeby po wciśnieciu przycisku "rejestracja" po wypełnieniu całości formularza umowy archiwizował ją w nowym arkuszu w kolejnym wolnym wierszu. Poniżej podrzucam kod który funkcjonuje dla zapisu w konkretnym wierszu. Możecie jakoś pomóc?

    Sub rejestracja()
    '
    ' rejestracja Makro
    '

    '
    Range("A2").Select
    Sheets("Umowa o dzielo").Select
    Range("D2").Select
    Selection.Copy
    Sheets("Spis umów").Select
    ActiveSheet.Paste
    Range("B2").Select
    Sheets("Umowa o dzielo").Select
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Spis umów").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("C2").Select
    Sheets("Umowa o dzielo").Select
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Spis umów").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("D2").Select
    Sheets("Umowa o dzielo").Select
    Range("A21:F21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Spis umów").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("E2").Select
    Sheets("Umowa o dzielo").Select
    ActiveWindow.SmallScroll Down:=33
    Range("D48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Spis umów").Select
    ActiveSheet.Paste
    Range("A2").Select
    End Sub

    jeśli ktoś chciałby pliczek poprawnie działający proszę na priv, nie bede zaśmiecał forum;)
    Pozdrawiam
    lukasz108
    Darmowe szkolenie: Ethernet w przemyśle dziś i jutro. Zarejestruj się za darmo.
  • Pomocny post
    Moderator Programowanie
    Tablica, pętla i jazda. Podepnij pod przycisk taki
    Kod: vb
    Zaloguj się, aby zobaczyć kod
  • Poziom 10  
    Szeroki uśmiech zagościł na mej twarzy, uczę się dopiero VBA, mała rzecz a cieszy jak dziecko co lizaka dostało;).
    Super, bardzo dziękuje, działa idealnie. Temat do zamknięcia, wyczerpany.
  • Poziom 29