Copying a Range in two different WorkSheets

[zubin]

Hi Guys....The code below copies three different ranges to a new location in the same worksheet......

Sheet1.Range("B4:B14").Copy
    Sheet1.Range("B" & Sheet1.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("E4:E14").Copy
    Sheet1.Range("D" & Sheet1.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("F4:F14").Copy
    Sheet1.Range("E" & Sheet1.Columns("E").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value

Everything fine.......but now my requirement has changed and I need that apart from the above ranges being copied simultaneously the below ranges should be copied in sheet4 of the same workbook

 Sheet1.Range("C4:C14").Copy
    Sheet4.Range("A" & Sheet4.Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("D4:D14").Copy
    Sheet4.Range("B" & Sheet4.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("E4:E14").Copy
    Sheet4.Range("C" & Sheet4.Columns("C").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value
    
    Sheet1.Range("F4:F14").Copy
    Sheet4.Range("D" & Sheet4.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Selection.Value = Selection.Value

How do I achieve this.....

 

[rollis13]

Maybe like this if I understood the request:

Sheet1.Range("B4:B14").Copy
Sheet1.Range("B" & Sheet1.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

Sheet1.Range("E4:E14").Copy
Sheet1.Range("D" & Sheet1.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
Sheet4.Range("C" & Sheet4.Columns("C").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

Sheet1.Range("F4:F14").Copy
Sheet1.Range("E" & Sheet1.Columns("E").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
Sheet4.Range("D" & Sheet4.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

Sheet1.Range("C4:C14").Copy
Sheet4.Range("A" & Sheet4.Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

Sheet1.Range("D4:D14").Copy
Sheet4.Range("B" & Sheet4.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

 

[zubin]

I tried it already It stops execution at this line of code

Sheet4.Range("C" & Sheet4.Columns("C").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues

and I had also added

Selection.Value = Selection.Value

at the end of each copy paste section....am i wrong somewhere ??

 

[rollis13]

Sheet4 needs to have some data in it if you are to use .Find.

Ehm, has no meaning to me, what was your goal with that code ? since you are using .PasteSpecial xlValues to paste data.

 

[zubin]

Ok....got it, removed the line

Selection.Value = Selection.Value

Now working fine Thanks a lot Rollis

 

[rollis13]

Maybe you could use at the beginning of the macro this:

Application.ScreenUpdating = False

and before the end:

Application.CutCopyMode = False
Application.ScreenUpdating = True

 

[zubin]

Can you please guide me to how to make this code work faster as time is a important factor....
like the original code where-in 3 ranges were copied (along with a few more lines of code) took around 4.50 seconds now adding another 4 ranges takes the time of execution to around 6.89 seconds. Now this is a drawback as this procedure requires to be quick.
so please if you can help out....

 

[zubin]

yes the original code has all.....
Application.ScreenUpdating = False
and before the end:
Code:
Application.CutCopyMode = False
Application.ScreenUpdating = True

 

[Marc L]

Hi,​

​

if only the values must be 'copied' so the better is to use DestinationRange.Value2 = SourceRange.Value2 …​

​

If the source data contains cells formated as Date so use Value rather than Value2.​

​

 

[zubin]

'Command Button ok
Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


If Range("B4").Value = vbNullString Then
frmSaleScan.TextBox1.SetFocus
Exit Sub
End If


Dim N As Long
Dim O As Long
 
'Online Payment
If CheckBox1.Value = True Then
    N = Cells(Rows.Count, "EO").End(xlUp).Row + 1
   Cells(N, "EO").Value = ActiveSheet.Range("F15").Value
    O = Cells(Rows.Count, "EP").End(xlUp).Row + 1
   Cells(O, "EP").Value = frmSaleScan.TextBox7.Value
 End If
 
    'Progress Bar Start......
    Dim j As Long
    Dim Max As Long
    Max = 20000
    'Initilaize the progress bar width
    InitProgressBar (Max)
    For j = 1 To Max
    DoEvents
    ShowProgress (j)
    Next j
    
    Sheet1.Range("B4:B14").Copy
    Sheet1.Range("B" & Sheet1.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    'Selection.Value = Selection.Value
    
    Sheet1.Range("C4:C14").Copy
    Sheet4.Range("A" & Sheet4.Columns("A").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    'Selection.Value = Selection.Value
    
    Sheet1.Range("D4:D14").Copy
    Sheet4.Range("B" & Sheet4.Columns("B").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    'Selection.Value = Selection.Value
    
    Sheet1.Range("E4:E14").Copy
    Sheet1.Range("D" & Sheet1.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Sheet4.Range("C" & Sheet4.Columns("C").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    'Selection.Value = Selection.Value
    
    Sheet1.Range("F4:F14").Copy
    Sheet1.Range("E" & Sheet1.Columns("E").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    Sheet4.Range("D" & Sheet4.Columns("D").Find("*", , xlValues, , xlRows, xlPrevious).Row + 2).PasteSpecial xlValues
    'Selection.Value = Selection.Value
        
      
    Application.CutCopyMode = False
    
    Sheet1.Range("B4:B14,E4:E14,F19:F20").ClearContents
        
        
    ActiveWorkbook.Save
    Unload Me
    frmSaleScan.Show
    frmSaleScan.TextBox1.SetFocus
    
    CloseProgressBar
    
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
  
    

End Sub

This is the code in its entirety