COUNT & Copy to Last Row, Paste to another sheet to Last Row (FIRST EMPTY ROW, adding, not replacing

[semiro1815]

Hey friends. Im New in VBA. Could you help me at this?

So, we have 2 columns: AB with data, in Sheet1
I want to COPY until Last Row in AB Column from Sheet1
and paste it to Sheet2, column CD in FIRST EMPTY ROW (i mean by adding more data, cause CD is supposed to have previous data)

Can anyone help? It would be a huge favour for me! THANKS !!

[#2]

@Hans Vogelaar  haha yes i changed it a little so perhaps it could be easier to understand.

and if i wanted all i said in the previous comment BUT with the only change that to be pasted not To Last Row, but always in Row2. (row 1 has headers for example and dont wanna touch). and the other (previous) data in those column A and B in sheet2, could shift below the new data pasted in row 2!

Can this happen?

(ps. That would save me a lot of work of second hands sheets)

[#3]

@semiro1815 

Sub CopyData()
    Dim m As Long
    Dim r As Long
    On Error Resume Next
    m = Worksheets("Sheet1").Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Err Then
        MsgBox "No data to copy!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    r = Worksheets("Sheet2").Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Worksheets("Sheet1").Range("A1:C" & m).Copy
    Worksheets("Sheet2").Range("A2:C" & m + 1).Insert Shift:=xlShiftDown
    Worksheets("Sheet1").Range("C1").Copy Destination:=Worksheets("Sheet2").Range("C2").Resize(m)
    Application.CutCopyMode = False
End Sub

[#4]

@Hans Vogelaar  Words are not enough to thank you my friend! :) You are amazing! God bless you! Thank you a lot !

[#5]

@semiro1815 

I left in a couple of lines that aren't needed anymore. Here is a version without them:

Sub CopyData()
    Dim m As Long
    On Error Resume Next
    m = Worksheets("Sheet1").Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Err Then
        MsgBox "No data to copy!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    Worksheets("Sheet1").Range("A1:C" & m).Copy
    Worksheets("Sheet2").Range("A2:C" & m + 1).Insert Shift:=xlShiftDown
    Worksheets("Sheet1").Range("C1").Copy Destination:=Worksheets("Sheet2").Range("C2").Resize(m)
    Application.CutCopyMode = False
End Sub

[#6]

Sure. thanks a lot

[#7]

@Hans Vogelaar  sorry and this is the last one. code works perfect and i just wanted the idea. but finds out cant do the custumization. The cells are like this in the photo:

i faced difficulties on modifying this. The idea is the same as previous comment, just the cells are slighlty different. Is this possible? Last question. Thanks billion times.

[#8]

@semiro1815 

The code now looks like this:

Sub CopyData()
    Dim m As Long
    On Error Resume Next
    m = Worksheets("Sheet1").Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Err Then
        MsgBox "No data to copy!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    Worksheets("Sheet1").Range("A1:B" & m).Copy
    Worksheets("Sheet2").Range("B2:C" & m + 1).Insert Shift:=xlShiftDown
    Worksheets("Sheet1").Range("D1").Copy
    Worksheets("Sheet2").Range("A2:A" & m + 1).Insert Shift:=xlShiftDown
    Application.CutCopyMode = False
End Sub

[#9]

@Hans Vogelaar  Super. Thank you. And just one more simple case.

what about just from:

Column A and Column B from Sheet1

to column A and column B, sheet2 (count copy paste) pasted to row2. 

And this what we pasted, to have the format and formulas of row3 in this sheet2.

(flexible formula, not fixed, like droping it, i mean to be suited to the current row,)

(this simple)

[#10]

@semiro1815 

Can you provide a sample workbook?

[#11]

@Hans Vogelaar  Yes just a sec !

[#12]

@Hans Vogelaar 

Like this: (in "earlier sheet2" please just a lil mistake, just "data" not "previous shifted data")

count copy paste to column a and column b from sheet1 to sheet2, and just keeping format and formulas from sheet2

[#13]

@semiro1815 

Please attach a sample workbook that has formatting and formulas.

[#14]

@Hans Vogelaar  Here:

[#15]

@semiro1815 

That looks different again! Its difficult to keep track if the layout and requirements change every time.

Sub CopyData()
    Dim m As Long
    On Error Resume Next
    m = Worksheets("Sheet1").Range("A:B").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Err Then
        MsgBox "No data to copy!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    Worksheets("Sheet2").Range("A2:E" & m).Copy Destination:=Worksheets("Sheet2").Range("A" & m + 1)
    Worksheets("Sheet2").Range("A2:B" & m).Value = Worksheets("Sheet1").Range("A2:B" & m).Value
End Sub

[#16]

@Hans Vogelaar 

Can you help me with a little trick?

I want to put in Cell B2 a formula through VBA, and then it applies /dropdowns / down below through B2 ( to B3, B4, B5, etc) until Last Used Row from Column A.

[#17]

i made ittt. no need. thanks a lot

[#18]

@Hans Vogelaar 

Hey my friend,

Is this possible in VBA :

In Sheet1 i have data. If in Column L, cells contain "Yes",

then Copy ONLY cells from Column B and Column D of the SAME ROW

and Paste to Sheet2 in Column A and Column C to Last Row?

Please. Appreciations. thanks.

[#19]

@semiro1815 

Try this:

Sub CopyData()
    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Dim c As Range
    Dim s As String
    Dim r1 As Long
    Dim r2 As Long
    Application.ScreenUpdating = False
    Set w1 = Worksheets("Sheet1")
    Set w2 = Worksheets("Sheet2")
    Set c = w1.Range("L:L").Find(What:="Yes", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not c Is Nothing Then
        On Error Resume Next
        r2 = w2.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        On Error GoTo 0
        s = c.Address
        Do
            r1 = c.Row
            r2 = r2 + 1
            w2.Range("A" & r2).Value = w1.Range("B" & r1).Value
            w2.Range("C" & r2).Value = w1.Range("D" & r1).Value
            Set c = w1.Range("L:L").Find(What:="Yes", After:=c, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
            If c Is Nothing Then Exit Do
        Loop Until c.Address = s
    End If
    Application.ScreenUpdating = True
End Sub

[#20]

@Hans Vogelaar 

Works Perfect! Thanks. And i im stuck at a little trick.

I have this formula:

=IF(OR(C2="",C2="-"), "-", (C2-TODAY())&" ditë ("&ROUNDUP(((C2-TODAY())/30),1)&" muaj)")

I want to put it to D2 and autofill (below), until Last Used Row from/based on Column A

i tried several ways but im facing issues ...

[#21]

@semiro1815 

Does this do what you want?

Sub FillIt()
    Dim r As Long
    Application.ScreenUpdating = False
    r = Range("A" & Rows.Count).End(xlUp).Row
    Range("D2:D" & r).FillDown
    Application.ScreenUpdating = True
End Sub