根据条件将特定单元格从一个工作簿复制到另一个工作簿中的不同单元格

时间:2015-07-20 16:38:29

标签: excel vba excel-vba

我有一个名为'EvaluationLog.xlsm'的工作簿,我需要将特定单元格(不是整行)从第一个工作表传输到位于同一目录中的另一个名为“IndicatorLog.xlsm”的现有工作簿。目标工作表也是第一个。我正在尝试将宏托管在'IndicatorLog'工作簿中。

如果“O”列中的内容为“否”,或者列“J”的内容为“初始”,则仅复制源中每行中的特定单元格。实际源数据从第8行开始,目标范围也从第8行开始。

除了一些非常简单的任务之外,我从来没有在VBA中编码,所以我被卡住了。

任何帮助将不胜感激! :)

Sub MergeFromLog()

Dim TargetSheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim SourceFileName As String
Dim WorkBk As Workbook
Dim LastRow As Integer, i As Integer, erow As Integer

' Set destination file.
Set TargetSheet = ActiveWorkbook.Worksheets(1)

' Modify this folder path to point to the files you want to use as source.
FolderPath = ""

' Set source file.
SourceFileName = FolderPath & "2015-2016 Evaluation Log.xlsm"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 8

' Open the source workbook in the folder
Set WorkBk = Workbooks.Open(SourceFileName)

LastRow = WorkBk.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For i = 8 To LastRow

    If WorkBk.Range(“O” & i) = "No" Or WorkBk.Range(“J” & i) = “Initial” Then

        ' Copy Student Name
        TargetSheet.Range("A" & NRow).Value = WorkBk.Range(“A” & i).Value
        ' Copy DOB
        TargetSheet.Range("B" & NRow).Value = WorkBk.Range(“C” & i).Value
        ' Copy ID#
        TargetSheet.Range("C" & NRow).Value = WorkBk.Range(“D” & i).Value
        ' Copy Consent Day
        TargetSheet.Range("D" & NRow).Value = WorkBk.Range(“L” & i).Value
        ' Copy Report Day
        TargetSheet.Range("E" & NRow).Value = WorkBk.Range(“N” & i).Value
        ' Copy FIE within District Timelines?
        TargetSheet.Range("F" & NRow).Value = WorkBk.Range(“O” & i).Value
        ' Copy Qualified?
        TargetSheet.Range("H" & NRow).Value = WorkBk.Range(“A” & i).Value
        ' Copy Primary Eligibility
        TargetSheet.Range("I" & NRow).Value = WorkBk.Range(“U” & i).Value
        ' Copy ARD Date
        TargetSheet.Range("J" & NRow).Value = WorkBk.Range(“R” & i).Value
        ' Copy ARD within District Timelines?
        TargetSheet.Range("K" & NRow).Value = WorkBk.Range(“S” & i).Value
        ' Copy Ethnicity
        TargetSheet.Range("M" & NRow).Value = WorkBk.Range(“F” & i).Value
        ' Copy Hisp?
        TargetSheet.Range("N" & NRow).Value = WorkBk.Range(“G” & i).Value
        ' Copy Diag/LSSP
        TargetSheet.Range("O" & NRow).Value = WorkBk.Range(“X” & i).Value

        NRow = NRow + 1

    End If

Next i

End Sub

2 个答案:

答案 0 :(得分:1)

我认为范围必须参考表格。

更改

If WorkBk.Range(“O” & i) = "No" Or WorkBk.Range(“J” & i) = “Initial” Then

If WorkBk.ActiveSheet.Range("O" & i) = "No" Or WorkBk.ActiveSheet.Range("J" & i) = "Initial" Then

答案 1 :(得分:1)

我猜测LastRow的值是< = 8,所以For i = 8 to lastRow循环根本就没有执行。

有关查找最后一行的更好方法,请参阅此处:

Error in finding last used cell in VBA

如果它正在执行,循环中的大多数语句都会引发438错误,正如@MatthewD在他的回答中指出的那样,Workbook对象没有Range方法,你会有将.Range限定为工作簿中特定的Worksheet对象。

所有语句如... WorkBk.Range(...必须更改为:

... WorkBk.ActiveSheet.Range(...