VBA自动生成固定资产标签打印

KalokFexcel

Fised Assets List ARU01 201812.zip (112.37 KB, 下载次数: 62)

2018-12-14 22:38 上传

点击文件名下载附件

求助哪位大神能帮帮忙，利用VBA自动填充生成固定资产标签打印的吗？
涕泗横流，感激不尽~

主要是想将表格中 盘点表 这张sheet的内容，填充至标签表中的每个标签中之后打印，不知那位大神能帮忙实现？
谢谢！

1414675912

完成制作。

1414675912

Sub Test() Application.ScreenUpdating = False i = 4 For a = 4 To 273 If j = 9 Then j = 0: i = i + 6: Rows(i - 2 & ":" & i + 2).Copy Rows(i + 4) j = j + 3     Sheets("标签").Cells(i, j).Value = Sheets("盘点表").Cells(a, 4)     Sheets("标签").Cells(i + 1, j).Value = Sheets("盘点表").Cells(a, 6)     Sheets("标签").Cells(i + 2, j).Value = Sheets("盘点表").Cells(a, 3) Next Application.ScreenUpdating = True End Sub

sgapple

试试行不行？

sgapple

Sub 生成标签()
Application.ScreenUpdating = False
'On Error Resume Next
Dim i, j, n, m, k As Integer, TB1, TB2 As Worksheet, rng As Range
Set TB1 = Worksheets("标签")
Set TB2 = Worksheets("盘点表")
Set rng = TB1.Range("B2:C6")
i = TB2.Cells(Rows.Count, 5).End(xlUp).Row
    With TB1
        For j = 4 To i
            For k = 1 To 3
                .Cells((j - 4) * 6 + 4, k * 3) = TB2.Cells((j - 3) * 3 + k, 4)
                .Cells((j - 4) * 6 + 5, k * 3) = TB2.Cells((j - 3) * 3 + k, 6)
                .Cells((j - 4) * 6 + 6, k * 3) = TB2.Cells((j - 3) * 3 + k, 3)
            Next
        Next
    End With
End Sub

YZC51

学习下
Application.ScreenUpdating = False
'On Error Resume Next
Dim i, j, n, m, k As Integer, TB1, TB2 As Worksheet, rng As Range
Set TB1 = Worksheets("标签")
Set TB2 = Worksheets("盘点表")
Set rng = Worksheets("标签模板").Range("1:5")
    TB1.Cells.Clear
    TB1.Cells.Rows.AutoFit
    i = TB2.Cells(Rows.Count, 5).End(xlUp).Row
    With TB1
            For j = 4 To i Step 3
                ri = TB1.Cells(Rows.Count, 2).End(xlUp).Row
            If j Mod 3 = 1 Then rng.Copy .Cells(ri + 2, 1)
        
            For k = 1 To 3
                .Cells(ri + 4, k * 3) = TB2.Cells(j + k - 1, 4)
                .Cells(ri + 5, k * 3) = TB2.Cells(j + k - 1, 6)
                .Cells(ri + 6, k * 3) = TB2.Cells(j + k - 1, 3)
            Next
        Next
    End With
    TB1.Rows("1:2").Delete
End Sub

YZC51

请参考
Fised Assets List ARU01 201812.rar (127.98 KB, 下载次数: 176)

2018-12-15 08:54 上传

点击文件名下载附件

KalokFexcel

1414675912 发表于 2018-12-15 01:19
完成制作。

好厉害，非常感谢！！！

KalokFexcel

YZC51 发表于 2018-12-15 08:53
学习下
Application.ScreenUpdating = False
'On Error Resume Next

想问下大神，这段代码具体需要怎么操作应用呢？

YZC51

KalokFexcel 发表于 2018-12-17 13:31
想问下大神，这段代码具体需要怎么操作应用呢？

双击盘点表b1单元格上的图标即可！