复制工作表之间的范围，在OriginalSheet的Col-E中搜索日期并将其插入A列的日期范围

时间：2017-06-14 15:21:10

标签： excel excel-vba date insert range vba

我是一个新手，但希望你能够帮助我打动我的新老板;）。

我的工作有一个程序，它将一堆数据输出到电子表格中（不能改变这一点，此时我只收到信息），并且从那个电子表格我被告知要手动复制 - 将范围（第一部分为A8至H8，第二部分为A9至H9，依此类推）添加到另一个基于日期（相同工作簿）的电子表格中，插入新行进行粘贴。

工作簿被称为＆＃34;发票＆＃34;。

电子表格1 - 原始列如下：空白，空白，空白，参考，日期，备忘录，代理，付费。

电子表格2 - 转移 - ，（按日期排序）：星期一，太阳日期，到期金额，参考，日期，备忘录，代理，付费。

所以目前我手动： 1.检查原始页面上的日期（E栏） 2.转到“转移”页面 3.查找它落在的日期范围（A列），如果有帮助，日期从A20开始。 4.在该日期范围内插入新行 5.返回原始页面 6.切割范围A-H 7.将其粘贴到单元格A-H中新创建的第2行中 8.将新E细胞重新着色为蓝色。

如您所见，两个页面上的列D-H是相同的。如果我们能够将E的值复制到A（日期）中，那就太棒了，但我可以没有它。

我一直试图制作一个宏来做到这一点，但我无法让它发挥作用。简而言之，我希望它在原始行E中查找日期，在转移行A中查找，在下面插入一行（日期随后下去），然后粘贴A：H范围。

如果有人可以帮助我，我会非常感激，如果他们可以告诉我如何循环宏，那么它就是Row8（数据首先出现的地方，然后返回并执行第9行，我＆＃ 39; d在月球上。如果它完全可能，我需要它从原始页面上的单元格Z1获取标签名称（表单名称），我已将其设置为输出它必须是宏，而不是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。

以下是宏YowE3K（已经黑屏私信）的情况。

The "Original" and "Transfer sheets". Transfer is empty and Original has the data I want to copy

What DID happen after running the macro and what I WANTED to happen. The cells all inserted themselves in a block, instead of each row inserting itself into a new row between the appropriate date ranges

以下是同事用来从＆＃34; Water Invoice＆＃34;中提取信息的内容。 （这将是我的原创），进入＆＃34;信任＆＃34;。他只需要在一个单元格中做一个值，但我必须做一个然后循环回来做下一行。

 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

1 个答案:

答案 0 :(得分：1)

所有宏都是用VBA编写的基本代码片段。

我建议您尝试使用微距录制功能。只需记录主要想法，选择X范围，然后将其复制到另一张纸上。

完成后，您可以调整代码以满足您的需求。

相关问题
最新问题