Home > OS >  Why my VBA not copy from column A instead of column F?
Why my VBA not copy from column A instead of column F?

Time:08-25

I’m a beginner for using VBA code to improved my working efficiency, I wrote a code to copy and paste columns from Sheet W2W to Sheet OTD Analysis when column F value doesn’t exist in OTD Analysis. But this code only copied column F:AU instead of A:AU, I wonder what’s wrong in the code and how I can resolve it. Please kindly help!

Sub Transfer()

    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("W2W").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundVal As Range
    For Each rng In Sheets("W2W").Range("F2:F" & LastRow)
        Set foundVal = Sheets("OTD Analysis").Range("F:F").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If foundVal Is Nothing Then
            rng.Columns("A:AU").Copy
            Sheets("OTD Analysis").Activate
            b = Sheets("OTD Analysis").Cells(Rows.Count,1).End(xlUp).Row
            Sheets("OTD Analysis").Cells(b   1, 1).Select
            ActiveSheet.Paste
        End If
    Next rng
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

CodePudding user response:

You want Columns("A:AU") in reference to the entire row.

rng.EntireRow.Columns("A:AU").Copy

CodePudding user response:

Transfer New Entries

  • Let's assume that rng is cell F2. Then
    • rng.Columns("A:AU") refers to the range F2:AZ2,
    • rng.EntireRow refers to the range A2:XFD2,
    • rng.EntireRow.Columns("A:AU") refers to the range A2:AU2.
Option Explicit

Sub TransferNewEntries()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source - to be read (copied) from
    Dim sws As Worksheet: Set sws = wb.Worksheets("W2W")
    Dim slRow As Long
    slRow = sws.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    Dim srg As Range: Set srg = sws.Range("A2", sws.Cells(slRow, "AU"))
    Dim scrg As Range: Set scrg = sws.Range("F2", sws.Cells(slRow, "F"))
    ' or e.g. just 'Set scrg = srg.Columns(6)'

    ' Destination - to be written (pasted) to
    Dim dws As Worksheet: Set dws = wb.Worksheets("OTD Analysis")
    Dim dlRow As Long
    dlRow = dws.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    Dim dcrg As Range: Set dcrg = dws.Range("F2", dws.Cells(dlRow, "F"))
    
    Dim surg As Range
    Dim sCell As Range
    Dim sr As Long
    Dim drIndex As Variant
    Dim drCount As Long
    
    For Each sCell In scrg.Cells
        sr = sr   1 ' the n-th cell of the source column range...
                    ' ... more importantly, the n-th row of the source range
        drIndex = Application.Match(sCell.Value, dcrg, 0)
        If IsError(drIndex) Then ' source value was not found
            drCount = drCount   1 ' count the rows to be copied
            If surg Is Nothing Then ' combine the rows into a range...
                Set surg = srg.Rows(sr)
            Else
                Set surg = Union(surg, srg.Rows(sr))
            End If
        'Else ' source value was found; do nothing
        End If
    Next sCell
    
    If surg Is Nothing Then
        MsgBox "No new entries (no action taken).", vbExclamation
        Exit Sub
    End If
    
    Dim dfCell As Range: Set dfCell = dws.Cells(dlRow   1, "A")
    surg.Copy dfCell ' ... to be copied in one go
    
    MsgBox "New entries copied: " & drCount, vbInformation
    
End Sub
  • Related