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 cellF2
. Thenrng.Columns("A:AU")
refers to the rangeF2:AZ2
,rng.EntireRow
refers to the rangeA2:XFD2
,rng.EntireRow.Columns("A:AU")
refers to the rangeA2: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