2016-07-17 227 views
0

我是VBA的新手,下面的代碼是我迄今爲止管理的,但是我想問問有人可以幫助格式化和公式複製嗎?VBA複製粘貼表格和公式

我有下面的代碼在我的項目運行,從一個名爲「更新質量檢查的數據」,基於由1 2方式的用戶名其他工作表的工作表傳輸數據,或者:

  • 通過觀察工作表的用戶名已經存在,只需複製相關數據 ;或者,
  • 通過創建與 用戶名作爲WS名稱的新工作表,並從數據表中複製數據

我想什麼時候創建一個新的用戶表格式添加會並將第一張用戶表格中的forumlas複製到新工作表和每個創建的附加用戶表中。

我見過很多線程來複制粘貼和剪貼板和pastespecial之間的參數,但現在我很困惑,不知道如何做到這一點目前不存在的工作表。有些人可以幫我嗎?

Public Sub transfer() 


Dim ws As Worksheet, wsName As Worksheet 
Dim lRow As Long, lPaste As Long 
Dim sName As String 


Set ws = Worksheets("Update Quality Check Data") 


With ws 
    For lRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 
     sName = .Cells(lRow, 2) 
     On Error Goto NoSheettFound 
Jumper: 
     Set wsName = Worksheets(sName) 
     On Error Goto 0 
     lPaste = wsName.Cells(Rows.Count, 3).End(xlUp).Row + 1 
     .Cells(lRow, 1).Copy Destination:=wsName.Cells(lPaste, 3) 
     .Cells(lRow, 3).Copy Destination:=wsName.Cells(lPaste, 4) 
    Next lRow 
End With 


Exit Sub 


NoSheettFound: 
Set wsName = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 
wsName.Name = sName 
ws.Select 
Goto Jumper 
End Sub 

親切的問候

約翰

回答

0

我這樣做有兩種方式。一,創建一個模板,這是一個隱藏的選項卡,我從中複製我的格式。

或者兩個,你可以在你的代碼中埋藏每個單元格的格式,併爲你想要的每個範圍調用它。例如:

Sub format1(r As Range) 

    With r 
     .Interior 
     .Interior.Pattern = xlSolid 
     .Interior.PatternColorIndex = xlAutomatic 
     .Interior.ThemeColor = xlThemeColorAccent1 
     .Interior.TintAndShade = 0.799981688894314 
     .Interior.PatternTintAndShade = 0 

     .Font.ThemeColor = xlThemeColorAccent2 
     .Font.TintAndShade = 0.399975585192419 
     .Font.Size = 12 
     .Font.Bold = True 
     .Font.Italic = True 

     .Borders(xlDiagonalDown).LineStyle = xlNone 
     .Borders(xlDiagonalUp).LineStyle = xlNone 
     .Borders(xlEdgeLeft).LineStyle = xlNone 
     .Borders(xlEdgeTop).LineStyle = xlContinuous 
     .Borders(xlEdgeTop).ColorIndex = 0 
     .Borders(xlEdgeTop).TintAndShade = 0 
     .Borders(xlEdgeTop).Weight = xlThin 
     .Borders(xlEdgeBottom).LineStyle = xlDouble 
     .Borders(xlEdgeBottom).ColorIndex = 0 
     .Borders(xlEdgeBottom).TintAndShade = 0 
     .Borders(xlEdgeBottom).Weight = xlThick 
     .Borders(xlEdgeRight).LineStyle = xlNone 
     .Borders(xlInsideVertical).LineStyle = xlNone 
     .Borders(xlInsideHorizontal).LineStyle = xlNone 
    End With 
End Sub 
+0

謝謝克裏,看起來不錯。對不起,聽起來無知,但你可以指導如何做到這一點?比方說,我的模板工作表被稱爲「鮑勃」,對於消光和公式在範圍D5:G10。 –

+0

@JohnWilliams,你可以做這樣的:'子TestBob() 昏暗的WS作爲工作表設置 WS =工作表( 「鮑勃」) 呼叫格式1(ws.Range( 「D5:G10」)) End Sub' ...這當然假設你在你的模板中有相同的單元格格式。 –

+0

@JohnWilliams,如果我有幫助,不要忘記提高我的答案。 –

0

下面是一個使用一個模板:

Sub FormatNewSheet(ws As Worksheet) 

Dim wsTemplate As Worksheet 
Set wsTemplate = Worksheets("Bob") 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
Application.CutCopyMode = False 

'Copy the range from the template 
wsTemplate.Range("D5:G10").Copy 


'Paste the format to the new range 
ws.Select 
ws.Range("D5:G10").Select 
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 

Application.EnableEvents = True 
Application.CutCopyMode = xlCopy 
Application.ScreenUpdating = True 


End Sub 

這裏是它的一個簡單的測試,通過工作表名稱的格式子:

Sub TestFormat() 

Dim ws As Worksheet 
Set ws = Worksheets("my new sheet") 

Call FormatNewSheet(ws) 

End Sub 

我希望幫助!

+0

謝謝克裏,理想的是你的幫助 –

+0

如果它對你有幫助,請不要忘記提升解決方案。謝謝! –