☰

Excel 宏：如果单元格 =“x”，则从其他工作表复制多个单元格

tag-icon • tag-icon microsoft-excel vba macros
Excel 宏：如果单元格 =“x”，则从其他工作表复制多个单元格

我在这里无法编写宏，但出于某种原因，我应该修复它......

我有一长串风险分析因素和相应的条目（每个风险一行），如果适用，则在 B 列中用“x”标记。第 15 行以下的列中没有其他数据，这就是我在开始时清除内容的原因。

该宏需要检查 B 列中是否有“x”，如果是，则将多列的内容（参见代码）从同一工作簿中的另一个工作表复制到活动工作表上的同一个单元格。

Short example of required function for line 15 (I need it for line 15 - end of document):

'delete content (done)
if CurrentWorksheet.B15 = "x"
  copy SourceWorksheet.I15 to CurrentWorksheet.I15
'  copy SourceWorksheet.Y15 to CurrentWorksheet.Y15 '(duplicate)
'  copy SourceWorksheet.AA15 to CurrentWorksheet.AA15 '(duplicate)
'  copy SourceWorksheet.AJ15 to CurrentWorksheet.AJ15 '(duplicate)
end if

Current State: 
finished

Sub InsertTSM()
' -----------------------------------------------------------
' Macro Insert TSM
' December 2020
' -----------------------------------------------------------
Dim i As Integer

On Error GoTo ErrHandler: 'Error handling

Application.ScreenUpdating = False

' Unprotect
 With ActiveSheet
        .Unprotect
 End With

' Delete current content
With ActiveSheet
    .Range("I15:I2000").ClearContents
    .Range("Y15:Y2000").ClearContents
    .Range("AA15:AA2000").ClearContents
    .Range("AJ15:AJ2000").ClearContents
End With

With ActiveSheet
        'Loop to check for "x" in column B
        For i = 15 To ActiveSheet.Cells(65536, 1).End(xlUp).Row 'row 15 to end of document (32bit Excel limit)
            If ActiveSheet.Cells(i, 2).Value = "x" Then 'check for "x" in column B
                ActiveSheet.Cells(i, 9).Value = Worksheets("FGR").Cells(i, 9).Value 'copy cell from column I
                ActiveSheet.Cells(i, 25).Value = Worksheets("FGR").Cells(i, 25).Value 'copy cell from column Y
                ActiveSheet.Cells(i, 27).Value = Worksheets("FGR").Cells(i, 27).Value 'copy cell from column AA
                ActiveSheet.Cells(i, 35).Value = Worksheets("FGR").Cells(i, 35).Value 'copy cell from column AJ
            End If
        Next i
End With




Application.ScreenUpdating = True

' Protect
 With ActiveSheet
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
 End With

Exit Sub
ErrHandler: 'call Sub for error handling
    Call ErrHandlerSub

End Sub

答案1

'--- Start Your unworking code ---
if CurrentWorksheet.B15 = "x"
  copy SourceWorksheet.I15 to CurrentWorksheet.I15
'  copy SourceWorksheet.Y15 to CurrentWorksheet.Y15 '(duplicate)
'  copy SourceWorksheet.AA15 to CurrentWorksheet.AA15 '(duplicate)
'  copy SourceWorksheet.AJ15 to CurrentWorksheet.AJ15 '(duplicate)
end if
'--- End Your unworking code ---

The following works completely.  Note that "Sheet2" is the source worksheet and "Sheet1 is the target worksheet.

'--- Start ---
If ActiveSheet.Range("B15").Value = "x" Then

  ActiveSheet.Range("I15").Value = Worksheets("Sheet2").Range("I15").Value

End If
'--- End ---

Hope this helps.

相关内容