2015-06-02 231 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.OpenWorksheets.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