upsidedown toskania 2011

Toskania 08/2011

upsidedown italy 2009

Italy, maj 2009

upsidedown maroko 2008

MAROCO 2008

step in toskania

Lotus Exige vs. Lamborghini Gallardo 16-07-2011

copa - ID

opis loga. pliki w RGB

upsidedown thai 2011

Koh maak - Thailand 2011

EXCEL VBA - kopiowanie tabeli do nowego arkusza i zmiana nazwy zakładki

Makro kopiuje tabele zawierającą dane z arkusza, otwiera plik "archiwum" tworzy tam zakładkę, wkleja dane i zmienia nazwę na podstawie jednej komórki z tej listy. Makro jest w pliku "DANE.xls"

Sub archiwum() 

Dim nazwa As String

' określenie komórki w której będzie nazwa nowej zakładki

nazwa = Cells(3, 1)

' kopiujemy dane które zawierają jakieś wartości

    Selection.CurrentRegion.Select

    Selection.Copy

'otwieramy plik "archiwum

   ' Application.WindowState = xlMinimized

        ChDir "C:\\DOKUMENTY"

    Workbooks.Open Filename:="C:\\DOKUMENTY\archiwum.xls"

    Windows("archiwum.xls").Activate

'tworzymy nową zakładkę i wklejamy dane

Sheets.Add

    ActiveSheet.Paste

'układamy kolumny, żeby ładnie wyglądały :)

    Columns("A:A").EntireColumn.AutoFit

        Columns("E:E").EntireColumn.AutoFit

    Columns("G:G").EntireColumn.AutoFit

    Columns("I:I").EntireColumn.AutoFit

    Columns("M:M").EntireColumn.AutoFit

    Range("A3").Select

    Application.CutCopyMode = False

    Selection.Copy

'zmieniamy nazwę zakładki

    Sheets("Arkusz1").Select

    Sheets("Arkusz1").Name = nazwa

' zapisujemy zmiany i zamykamy plik archiwum

    ActiveWorkbook.Save

    ActiveWorkbook.Close

    Windows("DANE.xls").Activate

    Range("A3").Select

End Sub

I jeszcze fragment kodu, który zmienia też nazwę zapisywanego pliku.

ActiveWorkbook.SaveAs Filename:= _

     "C:\\DOKUMENTY\plik_" & nazwa & ".xls" _

        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

        ReadOnlyRecommended:=False, CreateBackup:=False

    ActiveWorkbook.Close 

EXCEL VBA - generowanie zakładki pod korespondencje seryjną.

EXCEL
Kod filtruje listę (w zakładce "WORK") na podstawie określonych kryteriów i kopiuje do istniejącej zakładki( SERYJNA) (wcześniej ją czyszcząc) wartości, które potem są wykorzystywane do korespondencji seryjnej w wordzie

Sub gen_seryjna()

' wpierw czyścimy zakładkę "SERYJNA"

    Sheets("SERYJNA").Select

    Cells.Select

    Selection.Delete Shift:=xlUp

    Sheets("WORK").Select

' filtrujemy, "Field=10" to określenie kolumny, "kryteria" to kryteria filtrowania

    Selection.AutoFilter Field:=10, Criteria1:="OBCIĄŻENIE"

' zaznacza tylko komórki w których istnieją dane  

    Selection.CurrentRegion.Select 

    Selection.Copy

    Rows("1:1").Select

    Sheets("SERYJNA").Select

    Range("A1").Select

' wklejamy 

    ActiveSheet.Paste

' usuwamy pierwszy wiersz (który w moim pliku np zawierał przyciski, a nazwy kolumn były w drugim wierszu) 

    Rows("1:1").Select

    Application.CutCopyMode = False

    Selection.Delete Shift:=xlUp

' kolumny wyrównujemy 

    Columns("A:N").EntireColumn.AutoFit

    Sheets("WORK").Select

    Selection.AutoFilter Field:=10

    Range("A3").Select

    Application.ScreenUpdating = True

End Sub