0

我有一个 workbook1-->Sheet3 为 Marco 提供输入(我提供 24monthday秒:110、125、210、........1210、1225)。无论年份,输入始终为monthdays,每月 10 日和 25 日将接收数据。如果提到的日子不是非工作日,假设如果 10 日是假期,则可以用 11 日到 15 日之间的时间来代替。同样,如果 25 日是假期,则每个月的 26 日至 30 日都有可能。根据 sheet1 中的上述条件,需要对数据进行过滤。例如:如果monthday是 110,我会在 sheet1 中搜索。假设 sheet1 没有提到的“110”的数据,有可能直到“115”(但理想情况下,我在输入“sheet3”中只提供第 24 天)。请指导/帮助我解决问题 make vba。

Sub Creation()

Workbooks("Data").Sheets("Sheet3").Activate

For X = 1 To 24

Workbooks("Data").Sheets("Sheet3").Activate

If Range("A" & X).Value > 0 Then


monthday = Range("A" & X).Value

'MsgBox ("Creating Inventory Options for following: " & Range("A" & X))
If monthday > 0 Then
    Set NewBook = Workbooks.Add
        With NewBook
            .Title = monthday
            Test1Str = "Seperate_ Data Option Allocation_"
            TestStr = monthday

            ActiveWorkbook.SaveAs Filename:="D:\Macro Practice\" & Test1Str & TestStr
            Workbooks("Seperate_ Data Option Allocation_" & TestStr).Save

             Workbooks("Seperate_ Data Option Allocation_" & TestStr).Sheets("Sheet1").Name = "Data1"

    Workbooks("Seperate_ Data Option Allocation_" & TestStr).Sheets("Sheet2").Name = "Data2"
    Workbooks("Seperate_ Data Option Allocation_" & TestStr).Sheets("Sheet3").Name = "Calculation"
    Workbooks("Seperate_ Data Option Allocation_" & TestStr).Sheets.Add.Name = "Validation"           
    Workbooks("Data").Activate     
    Workbooks("Data").Sheets("Data2").Select
    Range("A1").Select
    Selection.AutoFilter field:=10, Criteria1:=Teststr
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Workbooks("Seperate_ Data Option Allocation_" & TestStr).Sheets("Data2").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Workbooks("Seperate_ Data Option Allocation_" & TestStr).Save
    end with
end if
next x
end sub
4

1 回答 1

0

我认为上面的代码复制了数据工作簿中的所有数据.. 最好替换以下两行

Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy

Dim rng As Range
Set rng = Range("A1").CurrentRegion
   rng.SpecialCells(xlCellTypeVisible).Copy
于 2013-10-02T04:03:32.003 回答