2016-07-17 225 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

如果它对你有帮助,请不要忘记提升解决方案。谢谢! –