复制工作表之间的范围，在OriginalSheet的Col-E中searchdate并在列A的date范围之间插入它
我是一个新手，但希望你能帮我打动我的新老板;）。
我的工作有一个程序，输出一堆数据到电子表格（不能改变这一点，我只能得到这个信息），并从该电子表格我被告知手动复制粘贴范围（第一节是A8到H8，第二部分是A9到H9，依此类推）到基于date（同一工作簿）的另一个电子表格中，插入一个新行来粘贴。
工作簿被称为“发票”。
电子表格1 – 原始 – 列如下：空白，空白，空白，参考，date，备忘录，代理，付费。
电子表格2 – 转账 – ，（按datesorting）：星期一，date，金额到期，参考，date，备忘录，代理，付费。
所以目前我手动：1.检查原始页面上的date（E栏）2.转到转移页面3.查找它所在的date范围（列A），如果有帮助，date从A20开始。 4.在该date范围内插入新行5.返回到原始页面6.剪切范围AH 7.将其粘贴到单元格AH中新创build的第2页的行中。重新着色新的E单元格为蓝色。
正如你所看到的，两个页面上的DH列是相同的。 如果我们能够将E的价值复制到A（date）中，那将是惊人的，但是我可以没有它。
我一直在试图做一个macros，但我却无法实现。 简而言之，我希望它在原始行E中查找date，在传输行A中查找它，在下面插入一行（date随后往下），然后粘贴A：H范围。
如果有人能够帮助我，我会非常感激，如果他们能告诉我如何循环macros，所以它Row8（数据第一次出现的地方，然后回去做9号行，我会在月球上。如果完全可能的话，我需要从原始页面的单元格Z1中获取标签名称（表格名称），我已经设置了它自动输出。它必须是macros而不是VBA。
非常感谢！
这是我的录制方法，如下所示：
Sub Macro3() 'In the sheet I need to TRANSFER to <- This part is fine Sheets("Transfer").Select 'Manually pick random row <- this needs to be done automatically based on comparing value of "Original" E to "Transfer" A. Rows("28:28").Select Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove ' Need to delete otherwise the pre-existing formulas wont flow <- Fine Selection.ClearContents ' Back to Original sheet <- Fine Sheets("Original").Select ' Select range I need to transfer <- Fine Range("A8:H8").Select Selection.Copy 'Back to TRANSFER sheet <- Fine Sheets("Transfer").Select 'Select the A column of the row I created above. <- Need automated to find the empty row Range("A28").Select 'Paste just the values. <- Find Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 然后，我需要它循环回来，做同样的事情，行9，直到它到达列表的末尾（长度不同 – 可能是5，可能是100。
这里是macros，YowE3K发生了什么（已经消除了私人信息）
“原稿”和“转印纸”。 传输是空的，原始有我想要复制的数据
运行macros之后发生了什么，以及我想要发生什么。 单元格全部插入到一个块中，而不是每一行都插入适当的date范围之间的新行中
下面是一个同事用来从“水发票”（这将是我的原始），从“信任”拉动信息的东西。 他只需要在一个单元格中做一个值，然后我必须做一个循环，然后做下一行。
Sub WaterInvoice3ToTrust() Dim water As Workbook Set water = Workbooks("Water Invoice.xlsm") 'Original File Dim trust As Workbook Set trust = Workbooks("Trust.xlsm") 'Transfer File Dim transfer As String Dim found As Range Dim search As Date Dim Discovered As Integer Dim onefrom As String On Error Resume Next ' Open Transfer file if not open already If Err <> 0 Then On Error GoTo 0 Workbooks.Open ("RETRACTED FOR PRIVACY") End If Discovered = 0 'Original File Workbooks("Water Invoice").Worksheets("00 Template").Activate transfer = water.Sheets("00 Template").Range("Z1") '<--Z1 is the same as my Z1, shows the tab name search = water.Sheets("00 Template").Range("AB8") ' <--This is his date, would be my E8 'Where to search While Discovered = 0 Set found = trust.Sheets(transfer).Range("A:A").Find(DateValue(search), LookIn:=xlFormulas, LookAt:=xlWhole) If Not found Is Nothing Then Discovered = 1 End If search = search - 1 Wend 'What to put in each cell <- I can edit this part myself, no worries trust.Sheets(transfer).Rows(found.Row).EntireRow.Insert trust.Sheets(transfer).Cells(found.Row - 1, "A") = water.Sheets("00 Template").Range("AB8") trust.Sheets(transfer).Cells(found.Row - 1, "B") = "-" trust.Sheets(transfer).Cells(found.Row - 1, "C") = water.Sheets("00 Template").Range("Z6") trust.Sheets(transfer).Cells(found.Row - 1, "D") = water.Sheets("00 Template").Range("AB8") trust.Sheets(transfer).Cells(found.Row - 1, "E") = "Water Usage" trust.Sheets(transfer).Cells(found.Row - 1, "F") = "RETRACTED" trust.Sheets(transfer).Cells(found.Row - 1, "G") = "$0.00" 'Cell formatting 'No idea what this does, assume formatting? onefrom = "G" & found.Row - 2 trust.Activate trust.Sheets(sheeet).Activate trust.Sheets(sheeet).Range(onefrom).Select Selection.AutoFill Destination:=Selection.Resize(3, 1), Type:=xlFillDefault 'No idea what this does, assume formatting? onefrom = "M" & found.Row - 2 trust.Activate trust.Sheets(sheeet).Activate trust.Sheets(sheeet).Range(onefrom).Select Selection.AutoFill Destination:=Selection.Resize(3, 1), Type:=xlFillDefault 'No idea what this does, assume formatting? onefrom = "N" & found.Row - 2 trust.Activate trust.Sheets(sheeet).Activate trust.Sheets(sheeet).Range(onefrom).Select Selection.AutoFill Destination:=Selection.Resize(3, 1), Type:=xlFillDefault 'This seems to make his E cell blue onefrom = "E" & found.Row - 1 trust.Sheets(sheeet).Range(onefrom).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With 'Go Back to Original workbook water.Activate ' Message Boxes <- I can edit this myself On Error Resume Next If Err Then MsgBox "Water was NOT entered into Trust.", vbExclamation Else MsgBox "Water was entered into Trust.", vbInformation End If On Error GoTo 0 End Sub
所有macros都是用VBA编写的基本代码段。
我build议你试试macros录制function。 只要logging主要想法，selectX范围，然后将其复制到其他工作表。
一旦你完成了，你可以调整代码来适应你的需求。