在另一个工作簿中搜索周号并复制到原始工作簿

时间:2018-09-28 19:02:06

标签: excel vba excel-vba

我试图根据该行在另一本工作簿中搜索“周数”(数字),一旦找到正确的“星期”,我想复制本周的值并将其粘贴到“活动工作簿”中。我似乎无法使它正常工作。

我能够打开正确的工作簿,所以我知道WeekFile变量不是问题。 WeekNumber变量等于包含(例如)“第39周”的单元格。假设范围A包含了我尝试从中获取数据的工作簿中的所有“周”。

Sub ImportTable()

    Dim count As Integer
    Dim WeekNumber As String

    WeekFile = Sheets("Sheet1").Range("J3")
    WeekNumber = Sheets("Sheet1").Range("O7")
    SlideSheet = ActiveWorkbook.Name

    count = 24

    fi$ = "H:\Location\" & WeekFile
    Workbooks.Open fileName:=fi$, ReadOnly:=True
    DataSheet= ActiveWorkbook.Name

    Do While Sheets("Sheet2").Range("A" & count) <> WeekNumber

        If Sheets("Sheet2").Range("A" & count) = WeekNumber Then

            Sheets("Sheet2").Range("B" & count & ":Q" & count).Copy

            Workbooks(SlideSheet).Activate

            Sheets("Sheet1").Range("P7:AE7").PasteSpecial xlValues

            Exit Do

        End If

        count = count + 1

    Loop

    Workbooks(DataSheet).Close SaveChanges:=False

End Sub

1 个答案:

答案 0 :(得分:0)

这更容易理解...

    Dim FilePath As String
        FilePath = "H:\Location\"

    Dim WeekFile As String
        WeekFile = ThisWorkbook.Sheets("Sheet1").Range("J3").Text

    Dim WeekNumber As String
        WeekNumber = ThisWorkbook.Sheets("Sheet1").Range("O7").Value

        Workbooks.Open Filename:=FilePath & WeekFile & ".xlsx", ReadOnly:=True 
        'use ".xls" extension if needed

    Dim FndwkNbr As Range
        Set FndwkNbr = ActiveWorkbook.Worksheets("Sheet2").Columns(1).Find(What:=WeekNumber, LookAt:=xlWhole, MatchCase:=False)

        FndwkNbr.Offset(, 1).Resize(, 16).Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("P7")
    End Sub