Avaleht
uus teema   vasta Tarkvara »  Programmeerimine »  Paluks Macro abi märgi kõik teemad loetuks
märgi mitteloetuks
vaata eelmist teemat :: vaata järgmist teemat
Hinnavaatlus :: Foorum :: Uudised :: Ärifoorumid :: HV F1 ennustusvõistlus :: Pangalink :: Telekavad :: HV toote otsing
autor
sõnum Saada viide sõbrale.  :: Teata moderaatorile teata moderaatorile
otsing:  
rayos
HV vaatleja

liitunud: 23.10.2003
sõnum 16.02.2014 19:22:58 Paluks Macro abi vasta tsitaadiga
Teema tegelikult lihtne : on 6 erinevat vihikut(vihik1;vihik2 jne) iga vihiku 1 lehest oleks vaja teha koopia. Peab tekkima vihik kus on kõikide vihikute 1 lehed järjestikuste sheetidel ja sheetid tuleb nimetad vihiku nr järgi.


Macro1 Macro

Sheets.Add After:=Sheets(Sheets.Count) // loob mulle nii mitu lehte ma soovin teiste vihikutest tuua
Sheets.Add After:=Sheets(Sheets.Count)
Sheets.Add After:=Sheets(Sheets.Count)



Workbooks.Open Filename:= _
"C:\Documents and Settings\A\Desktop\Test\Vihik1"

Windows("Vihik1.xlsx").Activate
Sheets("Leht1").Select
Cells.Select
Selection.Copy
Windows("Macro.xlsm").Activate
ActiveSheet.Paste // kleebib suvalisele lehele
Range("A1").Select // tervest lehest oleks koopiat vaja
Sheets("Leht1").Select
Sheets("Leht1").Name = "Vihik1"
Windows("Vihik1.xlsx").Activate
'Application.CutCopyMode = False
ActiveWindow.Close

viimati muutis rayos 17.02.2014 17:06:51, muudetud 1 kord
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
alfreedo
HV vaatleja

liitunud: 20.06.2010
sõnum 16.02.2014 23:04:33 vasta tsitaadiga
Ehk on abiks.


Sub Copy_Lehed_kokku()
Dim fso As Object, fld As Object, Fil As Object
Dim FilePath As String, fName As String, SubFolderName As String
Dim wb As Workbook, Wkb1 As Workbook
Dim SheetC As Integer
Dim Ipos As Long
Application.ScreenUpdating = False               ' et ekr-l ei vilguks
    Set wb = ActiveWorkbook                      ' s.o. fail kuhu andmed tuuakse
        Sheets(1).Select
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    SubFolderName = ThisWorkbook.Path
    FilePath = ActiveWorkbook.Path
     
      If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
         Set fld = fso.GetFolder(SubFolderName)
           
            For Each Fil In fld.Files
               
               If Fil.Name <> ThisWorkbook.Name And Left(Fil.Name, 1) <> "~" Then
                  fName = Fil.Name                 'ka uue lehe nime jaoks
                 
                  Application.DisplayAlerts = False ' keelab hoiatusaknad nagu: ...wbk sisaldab makrosid.... jne
                    Set Wkb1 = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
                        Wkb1.Activate
                       
                        'eemaldame faililaiendi
                        fName = Trim(fName)
                        Ipos = InStr(fName, ".")
                        fName = Left(fName, Ipos - 1)
                   
                        'Sheets(1) s.t. et copy-takse sõltumata lehe nimest Wbk-i esimene sheet.
                        Sheets(1).Activate
                        Wkb1.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
                        ActiveSheet.Name = fName
                        Wkb1.Close
                        wb.Save
               End If
            Next Fil
     
Sheets(1).Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True

'puhastame mälu
Set wb = Nothing
Set fld = Nothing
Set Wkb1 = Nothing
MsgBox "Done"
End Sub




Pane see kood .xlsm faili ja jooksuta.
.xlsm fail peab asuma samas kaustas, kus "vihikudki".
.xlsm failis ei tohiks olla vihikutenimelisi Lehti.
Kommentaarid: 2 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 2
tagasi üles
vaata kasutaja infot saada privaatsõnum
rayos
HV vaatleja

liitunud: 23.10.2003
sõnum 17.02.2014 17:18:20 vasta tsitaadiga
Ole sa tänatud icon_smile.gif
Kommentaarid: 1 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 1
tagasi üles
vaata kasutaja infot saada privaatsõnum
alfreedo
HV vaatleja

liitunud: 20.06.2010
sõnum 20.02.2014 21:45:42 vasta tsitaadiga
rayos.

Mul küll toimib ka formaadi copymine.

Spoiler Spoiler Spoiler
Kommentaarid: 2 loe/lisa Kasutajad arvavad:  :: 0 :: 0 :: 2
tagasi üles
vaata kasutaja infot saada privaatsõnum
näita postitusi alates eelmisest:   
uus teema   vasta Tarkvara »  Programmeerimine »  Paluks Macro abi
[vaata eelmist teemat] [vaata järgmist teemat]
 lisa lemmikuks
näita foorumit:  
 ignoreeri teemat 
sa ei või postitada uusi teemasid siia foorumisse
sa ei või vastata selle foorumi teemadele
sa ei või muuta oma postitusi selles foorumis
sa ei või kustutada oma postitusi selles foorumis
sa ei või vastata küsitlustele selles foorumis
sa ei saa lisada manuseid selles foorumis
sa võid manuseid alla laadida selles foorumis



Hinnavaatlus ei vastuta foorumis tehtud postituste eest.