Sub copySheets()
For Each ws In ThisWorkbook.Worksheets
'Dim wkb As Workbook
Dim wks As Worksheet
Dim wkb, wkb1 As Workbook
Set wkb = ThisWorkbook
Dim fd As FileDialog
Dim FileName As String
'Dim wks As Worksheet
Set fd = Application.FileDialog(msoFileDialogOpen)
Application.DisplayAlerts = False
'Set c = Sheets("formulas").Range("j19:j148").Find(ws.Name, lookat:=xlWhole)
'If Not c Is Nothing Then
Sheets(c.Value).Select
'the number of the button chosen
Dim FileChosen As Integer
FileChosen = fd.Show
fd.Title = "Choose workbook"
fd.InitialFileName = "c:\wise owl\"
fd.InitialView = msoFileDialogViewList
'show Excel workbooks and macro workbooks
fd.Filters.Clear
'fd.Filters.Add "Excel workbooks", "*.xlsx"
fd.Filters.Add "Excel macros", "*.xlsm"
fd.FilterIndex = 1
fd.ButtonName = "Choose this file"
If FileChosen <> -1 Then
'didn't choose anything (clicked on CANCEL)
MsgBox "No file opened"
Else
'get file, and open it (NAME property
'includes path, which we need)
FileName = fd.SelectedItems(1)
Workbooks.Open (FileName)
'End If
Set c = Sheets("formulas").Range("j19:j148").Find(ws.Name, lookat:=xlWhole)
If Not c Is Nothing Then
'need to copy from just opened worksheet to a file called "estimate test"
'Public Sub copyworksheet()
Set wkb = ThisWorkbook
Set wkb1 = Workbooks.Open(FileName)
Set wks = wkb.Sheets(c.Value)
wks.Copy After:=wkb1.Sheets(wkb1.Sheets.Count)
End If
Next
End Sub
-1
1 ответ
1
Этот макрос копирует лист с именем abc
из открытой книги в книгу Book2, адаптируя ее к вашему коду.
Public Sub copyworksheet()
Dim wkb, wkb1 As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wkb1 = Workbooks.Open("C:\users\me\Documents\Book2.xls")
Set wks = wkb.Sheets("abc")
wks.Copy After:=wkb1.Sheets(wkb1.Sheets.Count)
End Sub