简体   繁体   中英

VBA Adding cells from one sheet to another by cell

i wanna create button which add a cell from one sheet to another by time that was added. In image i showing example what i wanted to do. Adding first cells

So far i got this

Sub CopyBasedonSheet1()
Dim i As Integer
Dim j As Integer
Sheet1LastRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

i = 1
For j = 1 To Sheet1LastRow
    If Worksheets("Sheet1").Cells(j, 2).Value = "a" Then
        Worksheets("Sheet2").Cells(i, 1).Value = Worksheets("Sheet1").Cells(j, 1).Value
        Worksheets("Sheet2").Cells(i, 2).Value = Worksheets("Sheet1").Cells(j, 2).Value
        i = i + 1
    End If
Next j
End Sub

But when i add next cell and press button again it will overwrite whole cells in sheet 2. And i wanted to do it something like this: adding next cell Can you help me?

Your code says put Sheet1!A:A into Sheet2!A:A and Sheet1!B:B into Sheet2!B:B where Sheet1!B:B is "a" but your images say put Sheet1!A:A into Sheet2!A:A where Sheet1!B:B is "a" and disregard Sheet1!B:B. I'll choose the latter.

Option Explicit

Sub CopyBasedonSheet1()
    Dim j As Long, Sheet1LastRow As Long, Sheet2NextRow As Long     

    Sheet1LastRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    Sheet2NextRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row + _
          IsEmpty(Worksheets("Sheet2").Range("A1"))

    With Worksheets("Sheet1")
        For j = 1 To Sheet1LastRow
            If .Cells(j, "B").Value = "a" And _
              IsError(Application.Match(.Cells(j, "A").Value, Worksheets("Sheet2").Columns("A"), 0)) Then
                Worksheets("Sheet2").Cells(Sheet2NextRow, "A").Value = .Cells(j, "A").Value
                Sheet2NextRow = Sheet2NextRow + 1
            End If
        Next j
    End With
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM