Kopiowanie arkusza pomiędzy plikami

Witam,
Mam problem ze zmodyfikowaniem makra napisanego przez pana Piotra Korbicza


Set arkusz = ActiveWorkbook.Sheets("Arkusz1")
Set kopia = Workbooks.Add(1)
arkusz.Cells.Copy kopia.Sheets(1).Range("a1")

kopia.Sheets(1).Cells.Copy
kopia.Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues

Chciałbym aby z pliku Raport Logistyka W-Wa.xls skopiowany został arkusz "tel do pomp" i dodany do nowo utworzonego pliku. Plik powstał poprzez skopiowanie arkusza Beton w której jest tabela przestawną i na jej podstawie utworzene są arkusze zawierające nazwy zakładów. Plik tworzony ma nazwę File = "Plan wysyłek na dzień " & Worksheets("beton").Cells(3, 3).Value
Worksheets("beton").Cells(3, 3).Value = jest datą

Pozdrawiam

Poniżej kod makra:


Sub Wysli_raport()
               
    Set Arkusz = ActiveWorkbook.Sheets("tel do pomp")
               
    Sheets("beton").Select
    Sheets("beton").Copy
    ActiveWorkbook.ShowPivotTableFieldList = False
 
    Application.ScreenUpdating = False
   
    ' Pokaz strony
    ActiveSheet.PivotTables("Tabela przestawna1").ShowPages PageField:="Zakład"
   
    ' Sprawdzenie czy występują wszystkie zakłady
   
    Call Nowy019
    Call Nowy020
    Call Nowy022
    Call Nowy023
    Call Nowy068

    ' Formatowanie arkuszy

    Sheets("019 Warszawa Wolczynska").Activate
    Columns("A:K").Select
    Selection.ColumnWidth = 10
    Columns("A:A").Select
    Selection.ColumnWidth = 18
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 30
    Columns("E:E").Select
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 50
    ActiveWindow.Zoom = 75
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[46]C)"
    Selection.Font.Bold = True
    Range("A1").Select

    Sheets("020 Warszawa Konwaliowa").Activate
    Columns("A:K").Select
    Selection.ColumnWidth = 10
    Columns("A:A").Select
    Selection.ColumnWidth = 18
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 30
    Columns("E:E").Select
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 50
    ActiveWindow.Zoom = 75
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[46]C)"
    Selection.Font.Bold = True
    Range("A1").Select
   
    Sheets("022 Warszawa Klobucka").Activate
    Columns("A:K").Select
    Selection.ColumnWidth = 10
    Columns("A:A").Select
    Selection.ColumnWidth = 18
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 30
    Columns("E:E").Select
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 50
    ActiveWindow.Zoom = 75
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[46]C)"
    Selection.Font.Bold = True
    Range("A1").Select
   
    Sheets("023 Warszawa Zawodzie").Activate
    Columns("A:K").Select
    Selection.ColumnWidth = 10
    Columns("A:A").Select
    Selection.ColumnWidth = 18
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 30
    Columns("E:E").Select
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 50
    ActiveWindow.Zoom = 75
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[46]C)"
    Selection.Font.Bold = True
    Range("A1").Select
   
    Sheets("068 Warszawa Chelmzynska").Activate
    Columns("A:K").Select
    Selection.ColumnWidth = 10
    Columns("A:A").Select
    Selection.ColumnWidth = 18
    Columns("C:C").Select
    Selection.ColumnWidth = 30
    Columns("D:D").Select
    Selection.ColumnWidth = 30
    Columns("E:E").Select
    Selection.ColumnWidth = 18
    Columns("F:F").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 50
    ActiveWindow.Zoom = 75
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[46]C)"
    Selection.Font.Bold = True
    Range("A1").Select
       
    ChDir "\\Plwarfps01\groups\Dystrybucja\Plan wysyłek na dzień"
    Path = "\\Plwarfps01\groups\Dystrybucja\Plan wysyłek na dzień\"
   
    File = "Plan wysyłek na dzień " & Worksheets("beton").Cells(3, 3).Value
         
    Set kopia = Workbook.Add(1)
    Arkusz.Cells.Copy kopia.Sheets(1).Range("a1")

    kopia.Sheets(1).Cells.Copy
    kopia.Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues
 
    ActiveWorkbook.SaveAs Filename:=Path & File & ".xls"
       
    Application.DisplayAlerts = False
    Sheets("beton").Delete
    Application.DisplayAlerts = True
   
'    Call SendWithLotus
   
    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Application.Workbooks("Raport Logistyka W-Wa.xls").Activate
   
    Application.ScreenUpdating = True
   
End Sub

Sub Nowy019()
Dim test As Byte, i As Byte

test = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name = "019 Warszawa Wolczynska" Then
    test = 2
    End If
Next
If test = 1 Then
    Sheets.Add
    ActiveSheet.Name = "019 Warszawa Wolczynska"
End If
End Sub

Sub Nowy020()
Dim test As Byte, i As Byte

test = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name = "020 Warszawa Konwaliowa" Then
    test = 2
    End If
Next
If test = 1 Then
    Sheets.Add
    ActiveSheet.Name = "020 Warszawa Konwaliowa"
End If
End Sub

Sub Nowy022()
Dim test As Byte, i As Byte

test = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name = "022 Warszawa Klobucka" Then
    test = 2
    End If
Next
If test = 1 Then
    Sheets.Add
    ActiveSheet.Name = "022 Warszawa Klobucka"
End If
End Sub

Sub Nowy023()
Dim test As Byte, i As Byte

test = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name = "023 Warszawa Zawodzie" Then
    test = 2
    End If
Next
If test = 1 Then
    Sheets.Add
    ActiveSheet.Name = "023 Warszawa Zawodzie"
End If
End Sub

Sub Nowy068()
Dim test As Byte, i As Byte

test = 1
For i = 1 To Sheets.Count
    If Sheets(i).Name = "068 Warszawa Chelmzynska" Then
    test = 2
    End If
Next
If test = 1 Then
    Sheets.Add
    ActiveSheet.Name = "068 Warszawa Chelmzynska"
End If
End Sub

zanotowane.pl

doc.pisz.pl

pdf.pisz.pl

katkaras.opx.pl