简体   繁体   中英

Comparing last column of first row in sheet2 with F2 cell of sheet1 if it matches then show msgbox or else copy F2 range paste to sheet2

I have written a code but it's not working I want to copy a range F2:F24 from sheet1 and paste it to Sheet2 in incremental column-wise (Column_count+1), only if cell F2 value in sheet1 should not be equal to the last column of the first row in sheet2 If it matches then popup msgbox as "check_the _cell" Here is my code

Sub copycolumns()

Dim TargetSheet As Object
Set TargetSheet = Sheets("sheet2")

Dim TargetColumn As Integer
Dim LastC As Long
TargetColumn = TargetSheet.Range("F1").CurrentRegion.Columns.Count + 1
LastC = TargetSheet.Cells(1, TargetSheet.Columns.Count).End(xlToLeft).Column

If LastC = Sheets("sheet1").Cells(2, 6).Value Then


MsgBox "check the cell"


ElseIf TargetSheet.Range("F1") = "" Then

    TargetColumn = 6
End If

Sheets("sheet1").Range("F2:F24").Copy

TargetSheet.Activate
TargetSheet.Cells(1, TargetColumn).Select

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
        
Application.CutCopyMode = False


End Sub

表 1 表 2

Update_1: Before copying and pasting the RangeF2:F24 from Sheet1, it should compare the value of F2 (refer Image1) of Sheet1 and the last column of the first cell from sheet2 (Refer Image2, it is J1). If its value is the same then msgpop as error. if its value is different then copy F2:F24 and paste in last column of first row in sheet2

The line If LastC = Sheets("sheet1").Cells(2, 6).Value Then is comparing a column number with a date. Try

Option Explicit

Sub copycolumns()

    Const COPY_RANGE = "F2:F24"
    Const START_COL = 6 ' Target sheet F

    Dim wb As Workbook, ws As Worksheet, wsTarget As Worksheet
    Dim TargetColumn As Integer, LastColumn As Integer
    Dim dtNew As Date, dtLast As Date
    Dim rng As Range, rngTarget As Range

    ' source sheet 1
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set rng = ws.Range(COPY_RANGE)
    dtNew = rng.Cells(1, 1).Value ' F2

    ' target sheet 2 row 1
    Set wsTarget = wb.Sheets("Sheet2")
    LastColumn = wsTarget.Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' check if exists
    If LastColumn >= START_COL Then
        dtLast = wsTarget.Cells(1, LastColumn)
        If dtNew = dtLast Then
            MsgBox Format(dtNew, "dd-mmm-yyyy") & " exists in Column " & LastColumn, vbCritical
            Exit Sub
        End If
    Else
        LastColumn = START_COL - 1
    End If
    TargetColumn = LastColumn + 1

    ' copy to target
    rng.Copy
    Set rngTarget = wsTarget.Cells(1, TargetColumn)
   
    rngTarget.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'rngTarget.NumberFormat = "dd-mmm-yyyy"

    Application.CutCopyMode = False
    MsgBox Format(dtNew, "dd-mmm-yyyy") & " copied to column " & TargetColumn

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