• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy Selected Data and Paste to Specific Location (Empty Row) VBA

Y

yosibest

New Member
Hi guys, I am fairly new to VBA and I am looking for some help with some code that would help me at work, basically I am looking to reduce the amount of manipulating I have to a report on a daily basis.

I receive a report each day that contains shortages of stock, each day I have to cut/copy the data (without the headings) onto a second sheet where all the daily shortages are stored in date order and I also have to eliminate all shortages lower than 2.

This will then enable me to run analysis of the “relevant” data in Sheet2 by date.

I need some VBA code to do the following:

1. Copy the data from B7:M7 (row 6 contains the headers) down to the end of the data.

2. Pick all the rows where column “K” value is -2 or above (-3,-4 etc).

3. Paste the values onto column b of Sheet2 on the next blank cell (sheet two already formatted).

I’ll be very grateful of any help.
 

Attachments

  • Sample_Workbook.xlsx
    16.7 KB · Views: 5
Try this
Code: 
Sub Test()
    Dim Rng As Range, Cell As Range
    Set Rng = Sheet1.Range("K7:K" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row)
    For Each Cell In Rng
        If Cell <= -2 Then
            Sheet2.Range("A" & Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1).Value = Sheet1.Range("B2").Value
            Cell.Offset(, -9).Resize(1, 12).Copy Sheet2.Range("B" & Sheet2.Cells(Rows.Count, "B").End(xlUp).Row + 1)
        End If
    Next Cell
End Sub
 
Hi !

With real data worksheet, how many lines ?
'Cause faster way is not to use a loop, a filter & a simple copy do the job …
Maybe a training for Yasser …
​
 
You're welcome yosibest. Thanks for the feedback
Mr. Marc L : I'm still tiny comparing to you so we will wait for you to offer us the faster ways (I prefer arrays which I am still learning)
 
Here's another solution using filter method
Code: 
Sub CopyUsingFilter()
    Dim LastRow As Long
   
    Application.ScreenUpdating = False
        With Sheet1
            .AutoFilterMode = False
            .Range("B6").AutoFilter Field:=10, Criteria1:="<=" & -2
            LastRow = Sheet2.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            .Range("B6").CurrentRegion.Offset(2).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("B" & LastRow)
            Sheet2.Range("A" & LastRow).Resize(.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1, 1).Value = Sheet1.Range("B2").Value
            .AutoFilterMode = False
        End With
    Application.ScreenUpdating = True
End Sub
 
With real data the report includes an average of 1200 rows of data per day of those about 300 are -2 or above therefore will need copying across.
 

Yasser,

you can avoid SpecialCells 'cause Range.Copy - like Delete - takes
only visible cells !

If the order of copied lines is not a matter,
fastest is to sort lines before filter !
In this case, sort on K column : an unique block to copy …
​
 
So try this demonstration :​
Code: 
Sub Demo()
Application.ScreenUpdating = False
R& = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
  
With Sheet1.[B5].CurrentRegion.Rows
    With .Item("2:" & .Count)
         .Sort .Cells(10), xlAscending, Header:=xlYes
         .Columns(10).AutoFilter 1, "<=-2"
         .Offset(1).Copy Sheet2.Cells(R + 1, 2)
         .AutoFilter
    End With
End With
  
With Sheet2
         .Cells(R, 1).Copy
    With .Range(.Cells(R + 1, 1), .Cells(R, 2).End(xlDown)(1, 0))
         .PasteSpecial xlPasteFormats
         .Value = Sheet1.[B2].Value
    End With
         .Activate:  .Cells(1).Select:  Application.CutCopyMode = False
End With
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
You must log in or register to reply here.
Back
Top