2015-06-02 6 views
0

Мне нужно активировать конкретный рабочий лист. Код предназначен для создания рабочих листов со специфицированным именем. Мне нужно вставить что-то из другого листа во все эти вновь созданные рабочие листы. Код, который я использую, приведен ниже. Но мне сложно активировать вновь созданный рабочий лист, чтобы вставить то, что я хочу.Excel VBA активировать рабочий лист

Sub octo() 

'Dim ws As Worksheet 
    Dim Ki As Range 
    Dim ListSh As Range 
    Workbooks.Open ("C:\Users\Dash\Dropbox\Randika\Misc\Emmash timesheets\timesheet.xlsx") 
    With Worksheets("PPE 05-17-15") 
     Set ListSh = .Range("B4:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) 
    End With 

    On Error Resume Next 
    For Each Ki In ListSh 
     If Len(Trim(Ki.Value)) > 0 Then 
      If Len(Worksheets(Ki.Value).Name) = 0 Then 

       Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Ki.Value 
'open template 
    Workbooks.Open ("C:\Users\Dash\Dropbox\Randika\Misc\Emmash timesheets\octo_template.xls") 
    Range("A1:L31").Select 
    Selection.Copy 

    Worksheets(Ki.Value).Activate 

     If ThisWorkbook.Saved = False Then 
     ThisWorkbook.Save 
    End If 
      End If 
     End If 
    Next Ki 

End Sub 
+4

Нет необходимости активировать или выбирать для этого [см. Здесь некоторые идеи о том, как их избежать) (http://stackoverflow.com/a/10717999/445425) –

ответ

0

Я думаю, что это то, что вам нужно.
Как было сказано Крисом, нет необходимости Активировать или Выбрать. Надеюсь, что следующий код решит вашу проблему.

Option Explicit 
Dim MyTemplateWorkbook As Workbook 
Dim MyDataWorkbook As Workbook 
Dim MyTemplateWorksheet As Worksheet 
Dim MyDataWorksheet As Worksheet 
Dim MyNewDataWorksheet As Worksheet 
Dim CurrentRange As Range 
Dim ListRange As Range 

Sub AddWSAndGetData() 

Set MyTemplateWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyTemplate.xlsx") 
Set MyTemplateWorksheet = MyTemplateWorkbook.Sheets("Template") 
Set MyDataWorkbook = Workbooks.Open("C:\Users\lengkgan\Desktop\Testing\MyData1.xlsx") 
Set MyDataWorksheet = MyDataWorkbook.Sheets("PPE 05-17-15") 
Set ListRange = MyDataWorksheet.Range("B4:B" & MyDataWorksheet.Cells(Rows.Count, "B").End(xlUp).Row) 
Application.ScreenUpdating = False 

On Error Resume Next 
For Each CurrentRange In ListRange 
If Len(Trim(CurrentRange.Value)) > 0 Then 
    If Len(MyDataWorksheet(CurrentRange.Value).Name) = 0 Then 

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CurrentRange.Value 
    Set MyNewDataWorksheet = MyDataWorkbook.Sheets(ActiveSheet.Name) 
    MyNewDataWorksheet.Range("A1:L31").Value = MyTemplateWorksheet.Range("A1:L31").Value 

    If MyDataWorkbook.Saved = False Then 
     MyDataWorkbook.Save 
    End If 

    End If 
End If 
Next CurrentRange 
MyTemplateWorkbook.Close (False) 'Close the template without saving 
End Sub 
2

Оба Workbooks.Open и Worksheets.Add ссылки возврата в открытых и добавленных объектов, которые можно использовать для прямого доступа и изменять их - и в вашем случае, чтобы вставить данные.

Пример:

Dim oSourceSheet As Worksheet 
Dim oTargetSheet As Worksheet 

Set oSourceSheet = Sheet1 'Set reference to any sheet, Sheet1 in my example 
Set oTargetSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 
oSourceSheet.Range("A1:L31").Copy 
oTargetSheet.Paste 

Set oSourceSheet = Nothing 
Set oTargetSheet = Nothing 
Смежные вопросы