Question

我对VBA很新，下面的代码是我到目前为止所管理的，但我想问一下是否有人可以帮助格式化和公式复制呢？

我在我的项目中运行了以下代码，该代码从名为＆＃34;更新质量检查数据＆＃34;的工作表传输数据。通过2种方式之一基于用户名的其他工作表：

通过查看工作表的用户名已经存在而且只是复制相关数据;或者，
使用。创建新工作表用户名作为ws名称并从数据表中复制数据

我想添加的是当创建新用户工作表时，第一个用户表格中的格式和论坛会被复制到新工作表和每个创建的其他用户工作表中。

我看过很多线程要复制粘贴和剪贴板和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

亲切的问候

约翰

Answer 1

我已经做到了这两种方式。一，创建一个模板，它是我从中复制格式的隐藏选项卡。

或者两个，您可以在代码中隐藏每个单元格的格式，并为您想要的每个范围调用它。例如：

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

Answer 2

这是使用模板的人：

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：

Sub TestFormat()

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

Call FormatNewSheet(ws)

End Sub

我希望有所帮助！

VBA复制粘贴formmating和公式

2 个答案: