简体   繁体   中英

If cell on Sheet4 is not blank/empty, then make Values of cells on Sheet1 = Values of cells on Sheet4

Trying to get VBA to test if A2 on Sheet4 is not blank/empty, and if so, in other words when I paste there, to make Values of specific cells on Sheet1 to be same as Values of specific cells on Sheet4. But getting this error on second line of below code: 在此处输入图像描述

Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(ThisWorkbook.Sheets("sheet4").Range("a2").Value) = False Then
ThisWorkbook.Sheets("sheet1").Range("k6").Value = ThisWorkbook.Sheets("sheet4").Range("a2").Value
ThisWorkbook.Sheets("sheet1").Range("L6").Value = ThisWorkbook.Sheets("sheet4").Range("B2").Value
ThisWorkbook.Sheets("sheet1").Range("M6").Value = ThisWorkbook.Sheets("sheet4").Range("C2").Value
ThisWorkbook.Sheets("sheet1").Range("N6").Value = ThisWorkbook.Sheets("sheet4").Range("D2").Value
ThisWorkbook.Sheets("sheet1").Range("O6").Value = ThisWorkbook.Sheets("sheet4").Range("E2").Value
ThisWorkbook.Sheets("sheet1").Range("P6").Value = ThisWorkbook.Sheets("sheet4").Range("F2").Value
ThisWorkbook.Sheets("sheet1").Range("Q6").Value = ThisWorkbook.Sheets("sheet4").Range("G2").Value
ThisWorkbook.Sheets("sheet1").Range("R6").Value = ThisWorkbook.Sheets("sheet4").Range("H2").Value
ThisWorkbook.Sheets("sheet1").Range("S6").Value = ThisWorkbook.Sheets("sheet4").Range("I2").Value
'FIRST 9
ThisWorkbook.Sheets("sheet1").Range("L7").Value = ThisWorkbook.Sheets("sheet4").Range("J2").Value
ThisWorkbook.Sheets("sheet1").Range("M7").Value = ThisWorkbook.Sheets("sheet4").Range("K2").Value
ThisWorkbook.Sheets("sheet1").Range("N7").Value = ThisWorkbook.Sheets("sheet4").Range("L2").Value
ThisWorkbook.Sheets("sheet1").Range("O7").Value = ThisWorkbook.Sheets("sheet4").Range("M2").Value
ThisWorkbook.Sheets("sheet1").Range("P7").Value = ThisWorkbook.Sheets("sheet4").Range("N2").Value
ThisWorkbook.Sheets("sheet1").Range("Q7").Value = ThisWorkbook.Sheets("sheet4").Range("O2").Value
ThisWorkbook.Sheets("sheet1").Range("R7").Value = ThisWorkbook.Sheets("sheet4").Range("P2").Value
ThisWorkbook.Sheets("sheet1").Range("S7").Value = ThisWorkbook.Sheets("sheet4").Range("Q2").Value
'last 8
End If
End Sub

Here's Project Pane: 这是项目窗格:

Another error pic, while trying to fix second line for Sheet code name: 另一个错误图片

A Worksheet Change: Write Values to Another Worksheet

  • Note that your posted image is showing the code names, not the (tab) names of the worksheets, the ones in parentheses.
  • Also, the image is clearly showing that the worksheet, whose code name is Sheet1 is not named Sheet1 but has a longer name hence Run-time erorr '9': Subscript out of range .
  • In your code image, ThisWorkbook.Sheet4 is obviously invalid. You can either use Sheet4 or the worse ThisWorkbook.Worksheets("Sheet4") or the worst choice ThisWorkbook.Worksheets(4) .
  • Note that Me refers to the sheet in which module the code is in. You could omit Me. in the code or in this particular case, you could replace it with Sheet4. .
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    ' Define constants.        
    Const tCellAddress As String = "A2"
    Dim Cells1() As Variant: Cells1 = Array("K6:S6", "L7:S7")
    Dim Cells4() As Variant: Cells4 = Array("A2:I2", "J2:Q2")
    
    ' Reference the target cell ('tCell').
    Dim tCell As Range: Set tCell = Me.Range(tCellAddress)
    
    ' Check if the target cell was not changed.
    If Intersect(tCell, Target) Is Nothing Then Exit Sub
        
    ' Check if the target cell is blank.
    If Len(CStr(tCell.Value)) = 0 Then Exit Sub
    
    ' Write the values.
    Dim n As Long
    For n = LBound(Cells1) To UBound(Cells1)
        Sheet1.Range(Cells1(n)).Value = Me.Range(Cells4(n)).Value
    Next n
    
End Sub

Here's a working code:

Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Sheet4.Range("a2").Value) = False Then
Sheet1.Range("k6").Value = Sheet4.Range("a2").Value
Sheet1.Range("L6").Value = Sheet4.Range("B2").Value
Sheet1.Range("M6").Value = Sheet4.Range("C2").Value
Sheet1.Range("N6").Value = Sheet4.Range("D2").Value
Sheet1.Range("O6").Value = Sheet4.Range("E2").Value
Sheet1.Range("P6").Value = Sheet4.Range("F2").Value
Sheet1.Range("Q6").Value = Sheet4.Range("G2").Value
Sheet1.Range("R6").Value = Sheet4.Range("H2").Value
Sheet1.Range("S6").Value = Sheet4.Range("I2").Value
'FIRST 9
Sheet1.Range("L7").Value = Sheet4.Range("J2").Value
Sheet1.Range("M7").Value = Sheet4.Range("K2").Value
Sheet1.Range("N7").Value = Sheet4.Range("L2").Value
Sheet1.Range("O7").Value = Sheet4.Range("M2").Value
Sheet1.Range("P7").Value = Sheet4.Range("N2").Value
Sheet1.Range("Q7").Value = Sheet4.Range("O2").Value
Sheet1.Range("R7").Value = Sheet4.Range("P2").Value
Sheet1.Range("S7").Value = Sheet4.Range("Q2").Value
'last 8
End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM