2015-06-02 229 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