【问题标题】:Copy specific cells from one workbook to different cells in another depending on condition根据条件将特定单元格从一个工作簿复制到另一个工作簿中的不同单元格
【发布时间】:2015-07-20 16:38:28
【问题描述】:

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

仅当“O”列中的内容为“No”或“J”列中的内容为“Initial”时,才会复制源中每一行中的特定单元格。实际源数据从第 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

【问题讨论】:

  • 您的具体问题是什么?
  • 对不起,它似乎没有做任何事情。 :(
  • 你有没有通过代码来确定它没有做任何事情?
  • 我猜LastRow 的值是For i = 8 to lastRow 循环根本没有执行。
  • 大卫,我认为你引导我的方向是正确的。现在我收到此错误:“对象不支持方法的此属性”在以下行中: TargetSheet.Range("A" & NRow).Value = WorkBk.Range("A" & i).Value

标签: vba excel


【解决方案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

【讨论】:

  • 很好——如果她的代码正在执行,它将在该行引发 438 错误,但这不是 OP 的错误,即“代码没有做任何事情”。她将需要单步执行她的代码并找出For 循环未执行的原因。
  • 谢谢你们!你的回答对我有帮助!现在我收到此错误:“对象不支持方法的此属性”在以下行中: TargetSheet.Range("A" & NRow).Value = WorkBk.Range("A" & i).Value
  • 不确定如果不使用“选项显式”是否会引发错误。
  • @MatthewD 它会引发错误,但不会引发编译错误,因此只要不执行这些语句,代码就可以实际执行。
  • 同样的问题。将 WorkBk.Range("A" & i).Value 更改为 WorkBk.ActiveSheet.Range("A" & i).Value
【解决方案2】:

我猜LastRow 的值是For i = 8 to lastRow 循环根本没有执行。

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

Error in finding last used cell in VBA

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

... WorkBk.Range(... 之类的所有语句都必须更改为:

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

【讨论】:

  • 这帮助我摆脱了之前的错误!!谢谢! :)
猜你喜欢
  • 2020-11-11
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2012-12-08
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多