从可变单元格复制数据并粘贴到另一个电子表格中的固定单元格

时间：2013-05-23 13:56:28

标签： vba excel-vba copy-paste excel

我希望在excel 2013中构建一个宏，它可以执行以下操作：

  1. 从一个电子表格（电子表格1）中复制单个单元格中的数据。列永远不会改变，但行将是一个不断更新的部件数据库。

  2. 将电子表格1中的数据粘贴到另一个电子表格（电子表格2）中的相应单元格中。电子表格2中的单元格永远不会改变。

  3. 打印此文档。

  4. 对电子表格1中的下一行数据重复步骤1-3。

    5. 注意：理想情况下，宏允许用户突出显示他们要复制到电子表格2中的电子表格1中的数据部分。宏将打印出适用于电子表格1中每个订单项的电子表格2版本。

    我欢迎任何人可以给我的建议。

    当前代码：

    Sub SOAutomator()
'
' SOAutomator Macro
'

'
Range("A4").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A5").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A6").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A7").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A8").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A9").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A10").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

Range("A11").Select
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("A7:D7").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("I5:K5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("E11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("E5:G5").Select
ActiveSheet.Paste
Windows("Shop Order Automator Macro.xlsm").Activate
Range("F11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Job Sheet Templates.xlsx").Activate
Range("H5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
    :=True, IgnorePrintAreas:=False
Windows("Shop Order Automator Macro.xlsm").Activate

End Sub

1 个答案:

答案 0 :(得分：0)

编译好，但未经过测试...... 

Sub SOAutomator()

Dim shtTemplate As Worksheet
Dim shtMacro As Worksheet
Dim rw As Range


    'adjust sheet names as needed...
    Set shtTemplate = Workbooks("Job Sheet Templates.xlsx").Sheets("Sheet1")
    'assumes macro is in "macro" workbook
    Set shtMacro = ThisWorkbook.Sheets("Data")     

    Set rw = shtMacro.Rows(4) 'start on row 4

    'run until hit an empty cell in the first column...
    Do While Len(rw.Cells(1).Value) > 0

        With rw
            .Cells(1).Copy shtTemplate.Range("A5")
            .Cells(3).Copy shtTemplate.Range("A7:D7")
            .Cells(4).Copy shtTemplate.Range("I5:K5")
            .Cells(5).Copy shtTemplate.Range("E5:G5")
            .Cells(6).Copy shtTemplate.Range("H5")
        End With

        shtTemplate.PrintOut From:=1, To:=1, Copies:=1, _
                     Collate:=True, IgnorePrintAreas:=False

        Set rw = rw.Offset(1, 0) 'next row

    Loop

    ThisWorkbook.Activate

End Sub
相关问题
最新问题