Excel sayfalarını yeni bir çalışma kitabına kopyalama

[tamer42]

Merhaba,
Aşağıdaki kod ile bir dosyadaki sayfayı yeni bir çalışma kitabına formülsüz kopyalama yapıyor.

Burada sadece 1 sayfayı kopyalayabiliyorum, 2. sayfayı da aynı çalışma kitabına ("Target.xlsx") kopyalamak için nasıl bir düzenleme yapmak gerekir?

ilginize şimdiden teşekkürler,

Sub Sample()
Dim ws As Worksheet
Dim mypath As String
Dim s1 As String, s2 As String


s1 = "LOGO MALİYET"
s2 = "LOGO SATIŞ"


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        
    End With
    
mypath = ThisWorkbook.Path

    '~~>
    '~~>
   ThisWorkbook.Sheets(s1).Copy
    
     Set ws = ActiveWorkbook.ActiveSheet
     
        With ws.UsedRange
            .Value = .Value
        End With

    '~~> Save the new workbook
    ActiveWorkbook.SaveAs mypath & "\Target.xlsx", FileFormat:=51
    
    Set ws = Nothing
    
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        
    End With
    
    
End Sub

 

[halit3]

ThisWorkbook.Sheets(s1).Copy

yukarıdaki bölümün yerine aşağıdaki bölümü ekleyip denermisiniz.

Sheets(Array(s1, s2)).Copy

 

[tamer42]

ThisWorkbook.Sheets(s1).Copy

yukarıdaki bölümün yerine aşağıdaki bölümü ekleyip denermisiniz.

Sheets(Array(s1, s2)).Copy

teşekkürler Halit hocam

 

[tamer42]

ThisWorkbook.Sheets(s1).Copy

yukarıdaki bölümün yerine aşağıdaki bölümü ekleyip denermisiniz.

Sheets(Array(s1, s2)).Copy

Halit hocam bir şey daha sorabilir miyim?
Gizli sayfaları açmak için;

 Sheets(Array(s1, s2)).Visible = True

bu şekilde hata veriyor, bir öneriniz olur mu?

 

[halit3]

Eğer dosyanız korumalı değilse gizli sayfaları önce aktif edip işlemler bittikten sonrada tekrardan gizlenebilir.

 Sub deneme()

Dim ws As Worksheet
Dim mypath As String
Dim s1 As String, s2 As String

s1 = "Sayfa1" ' "LOGO MALİYET"
s2 = "Sayfa2" '"LOGO SATIŞ"

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

mypath = ThisWorkbook.Path

ReDim kontrol(ThisWorkbook.Sheets.Count)

For j = 1 To ThisWorkbook.Sheets.Count
kontrol(j) = ThisWorkbook.Sheets(Sheets(j).Name).Visible
ThisWorkbook.Sheets(Sheets(j).Name).Visible = True
Next

ThisWorkbook.Sheets(Array(s1, s2)).Copy

Set ws = ActiveWorkbook.ActiveSheet

With ws.UsedRange
.Value = .Value
End With
'~~> Save the new workbook
ActiveWorkbook.SaveAs mypath & "\Target.xlsx", FileFormat:=51

Set ws = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

For j = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(Sheets(j).Name).Visible = kontrol(j)
Next


End Sub

 

[tamer42]

Eğer dosyanız korumalı değilse gizli sayfaları önce aktif edip işlemler bittikten sonrada tekrardan gizlenebilir.

Sub deneme()

Dim ws As Worksheet
Dim mypath As String
Dim s1 As String, s2 As String

s1 = "Sayfa1" ' "LOGO MALİYET"
s2 = "Sayfa2" '"LOGO SATIŞ"

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

mypath = ThisWorkbook.Path

ReDim kontrol(ThisWorkbook.Sheets.Count)

For j = 1 To ThisWorkbook.Sheets.Count
kontrol(j) = ThisWorkbook.Sheets(Sheets(j).Name).Visible
ThisWorkbook.Sheets(Sheets(j).Name).Visible = True
Next

ThisWorkbook.Sheets(Array(s1, s2)).Copy

Set ws = ActiveWorkbook.ActiveSheet

With ws.UsedRange
.Value = .Value
End With
'~~> Save the new workbook
ActiveWorkbook.SaveAs mypath & "\Target.xlsx", FileFormat:=51

Set ws = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

For j = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(Sheets(j).Name).Visible = kontrol(j)
Next


End Sub

teşekkürler...