Új hozzászólás Aktív témák

• #38327 Delila_1 veterán dellfanboy #38326

  Új Válasz 2018-06-12 17:45:32 #38327

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz dellfanboy #38326 üzenetére

  Cseréld ki a makrót erre

  Sub Masolasok()
Dim WBE As Workbook, WSM As Worksheet, ide As Long
Dim FD, utvonal As String, FN As String, valasz

Set WBE = ActiveWorkbook

Sheets(1).Copy '1. lap másolása
Set WSM = ActiveWorkbook.Sheets(1)
WSM.Name = "Eredmény"
ide = WSM.Range("A" & Rows.Count).End(xlUp).Row + 1 '2. lap másolása
WBE.Sheets(2).Range("A1").CurrentRegion.Offset(1).Copy Range("A" & ide)

ide = WSM.Range("A" & Rows.Count).End(xlUp).Row + 1 '3. lap másolása
WBE.Sheets(3).Range("A1").CurrentRegion.Offset(1).Copy Range("A" & ide)

'Másolt fájl neve és útvonala
valasz = MsgBox("Megfelel a riport 1 cím a mentendő fájlnak?", vbExclamation + vbYesNo, "Fájlnév")
If valasz = 7 Then
FN = Application.InputBox("Add meg a mentendő fájl nevét kiterjesztés nélkül!", , , , , , 2)
Else: FN = "riport 1"
End If
MsgBox "Válassz útvonalat", vbExclamation
Set FD = Application.FileDialog(4) 'mappa választás
With FD
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Nem választottál útvonalat, befejezzük.", vbInformation, "Értesítés"
Exit Sub
Else
utvonal = .SelectedItems(1)
End If
End With
ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs utvonal & "\" & FN & ".xlsx" 'mentés
End Sub

Új hozzászólás Aktív témák