Copy noncontiguous ranges to a contiguous range

[Xceller]

Hi All,

I am trying to copy some noncontiguous ranges from a Input sheet to a contiguous range in a dBASE sheet. However, I want to check and see if the data being copied and pasted are already in the database. If the data already exists then exit, else run code.

Sub copyNpaste()
Dim WSI As Worksheet
Dim WSD As Worksheet

Set WSI = Worksheets("Input")
Set WSD = Worksheets("dBASE")

' if there is match in the date range ("A:A") then exit
For Each cell In Worksheets("dBASE").Range("A:A")

Worksheets("Input").Range("E5") = cell.Value
MsgBox ("This data is already in database")

Else

' Else run this set of codes
FinalRow = Sheets("dBASE").Cells(Rows.Count, 1).End(xlUp).Row

WSD.Cells(FinalRow + 1, 1).Resize(7, 1).Value = WSI.Range("C14:C20").Value
WSD.Cells(FinalRow + 7, 1).Resize(7, 1).Value = WSI.Range("C24:C30").Value

WSD.Cells(FinalRow + 1, 2).Resize(7, 1).Value = WSI.Range("O14:O20").Value
WSD.Cells(FinalRow + 7, 2).Resize(7, 1).Value = WSI.Range("O24:O30").Value

WSD.Cells(FinalRow + 1, 3).Resize(7, 1).Value = WSI.Range("S14:S20").Value
WSD.Cells(FinalRow + 7, 3).Resize(7, 1).Value = WSI.Range("S24:S30").Value

WSD.Cells(FinalRow + 1, 4).Resize(7, 1).Value = WSI.Range("T14:T20").Value
WSD.Cells(FinalRow + 7, 4).Resize(7, 1).Value = WSI.Range("T24:T30").Value

WSD.Cells(FinalRow + 1, 5).Resize(7, 1).Value = WSI.Range("U14:U20").Value
WSD.Cells(FinalRow + 7, 5).Resize(7, 1).Value = WSI.Range("U24:U30").Value

Next cell

End Sub

 

[JoeMo]

Might be easier to copy everything to a contiguous range, then remove duplicates.