Copying noncontiguous ranges pasting to a contiguous range

[Xceller]

I am trying copy 10 ranges from an Input Sheet and past them to a Database list format sheet. The problem is that there are 3 sub-total rows in Worksheet("Input"), row 21,21 and 23, but the code below copies these 3 row to Worksheet("dBASE"). Any help is greatly appreciated.


Sub copyNpaste()

Dim WSI As Worksheet
Dim WSD As Worksheet

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


WSI.Range("C14:C20", "C24:C30").Value = WSD.Cells(FinalRow + 1, 1)
WSI.Range("O14:O20", "O24:O30").Value = WSD.Cells(FinalRow + 1, 2)
WSI.Range("S14:S20", "S24:S30").Value = WSD.Cells(FinalRow + 1, 3)
WSI.Range("T14:T20", "T24:T30").Value = WSD.Cells(FinalRow + 1, 4)
WSI.Range("U14:T20", "U24:T30").Value = WSD.Cells(FinalRow + 1, 5)

End Sub()

 

[AlphaFrog]

Try something like this...

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

 

[Xceller]

Thanks for the help. I tried something like that and it works. I am trying to put some safeguard in the codes so that it will run a match in the existing database to see if the data being copied and paste is already exist in the database to avoid double netries. Could this be accomplished?

Something like: If(Match("Date","A:A",0)=true Then MsgBox "Data already exist"

Else
' Run Code


I just don't know how to write this in vba code.

 

[AlphaFrog]

Maybe use the .Find method

Example:

If Not Range("A:A").Find("Date") Is Nothing Then
   MsgBox "Data already exist"
Else
   'Run code
End If

There are several optional arguments for the .Find method you should explore. Do a web search for Excel VBA .Find method for more examples.

 

[Xceller]

I will your advice a little later. I tried the codes below and run into some problems with the constuct. I don't know where to put the "Else" and "Next Cell". Can you kindly take a look and see what is wrong. Thanks


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

 

[AlphaFrog]

Sub copyNpaste()

    Dim WSI As Worksheet
    Dim WSD As Worksheet
    Dim FinalRow As Long
    
    Set WSI = Worksheets("Input")
    Set WSD = Worksheets("dBASE")
    
    ' if there is match in the date range ("A:A") then exit
    If Not WSD.Range("A:A").Find(WSI.Range("E5")) Is Nothing Then
    
        MsgBox "This data is already in database."
    
    Else
        
        ' Else run this set of codes
        FinalRow = WSD.Cells(Rows.Count, "A").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
        
    End If

End Sub

 

[Xceller]

Thanks again for your help. It works! I have one question
When I replace the line of code in red below
"WSD.Range("A2").Resize(FinalRow - 1, 1)"
with this:
"WSD.dRange."
it stops working. Since I already set dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)
I dont understand why it doesn't work.

Sub copyNpaste1()

Dim WSI As Worksheet
Dim WSD As Worksheet


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


FinalRow = Sheets("dBASE").Cells(Rows.Count, 1).End(xlUp).Row
dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)
CurrentDate = Sheets("Input").Range("E5").Value

If Not WSD.Range("A2").Resize(FinalRow - 1, 1).Find(CurrentDate) Is Nothing Then
MsgBox "Data already exist"
Exit Sub
Else


WSD.Cells(FinalRow + 1, 1).Resize(7, 1).Value = WSI.Range("C14:C20").Value
WSD.Cells(FinalRow + 8, 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 + 8, 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 + 8, 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 + 8, 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 + 8, 5).Resize(7, 1).Value = WSI.Range("U24:U30").Value
End If
End Sub

 

[AlphaFrog]

Don't put WSD in front of dRange.

• WSD is the worksheet Dbase.
• dRange is a cell range on DBase and it includes that worksheet as part of its identity.

So if you use WSD.dRange, then that's redundant. It's like saying;
Sheets("dBASE").Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)

This should work...

If Not dRange.Find(CurrentDate) Is Nothing Then

Forum Tip:
It would be best if you surround your VBA code with code tags e.g.; [CODE]your VBA code here[/CODE]
It makes reading your VBA code much easier.
When you're in the forum editor, highlight your pasted VBA code and then click on the icon with the pound or number sign # (a.k.a. hash, hex, octothorp)

 

[Xceller]

Tried it. It doesn't work.

 

[Andrew Poulsom]

You need :

Set dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)

to assign that range to a Range object.