CODEWITHSUNDEEP
excelvbaformscopy-paste
DaniloS
DaniloS

Reputation: 13

Copy entire row to the next empty row in another worksheet which begins from specific row

I have tried to search for an answer in this forum, I´ve also tried to modify the code to suit my requirement but still without success. Could someone please help me?

I have an excel document with 6 sheets. All sheets have an identical (fixed) form. First 5 sheets are basically databases where I have electrical parts from 5 different projects, and 6th Sheet is an empty form, which should be used as an order list.

What I need is a code that will copy the entire row from sheet 1/2/3/4/5 to the Sheet 6 if the criteria is met. The criteria is an entered quantity (different from 0) in column C (Sheets 1/2/3/4/5). That what is the main problem, I need to copy entire row to the next empty row in Sheet 6 – but form begins from the row 14 (A14), above is a header.

Now I have code for command button which works only if I am working in one sheet and trying to copy rows to Sheet 6 (Order list). If I am working in Sheet 5 and I jump for example to Sheet 3, and if I try to add some more parts to order list from Sheet 3, it will just copy all over the existing parts in order list, which I already copied from Sheet 5.

Here is the code which I have so far (in this example I used only Sheet 5 - "Gemeinsam"):

Private Sub CommandButton1_Click()
    a = Worksheets("Gemeinsam").Cells(Rows.Count, 5).End(xlUp).Row
    b = 14
    For i = 14 To a

       If Worksheets("Gemeinsam").Cells(i, 3).Value > 0 Then

          Worksheets("Gemeinsam").Rows(i).Copy
          Worksheets("Stückliste").Activate
          Worksheets("Stückliste").Cells(b, 1).Select
          ActiveSheet.Paste
          Worksheets("Gemeinsam").Activate
       b = b + 1
       End If
    Next

Application.CutCopyMode = False

ThisWorkbook.Worksheets("Gemeinsam").Cells(14, 1).Select

End Sub

Upvotes: 1

Views: 583

Answers (1)

Darrell H
Darrell H

Reputation: 1886

This assumes you only have the 6 worksheets in the workbook. Some of the variable names have been changed, but hopefully understood.

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim DestLastRow As Long
    Dim LastRow As Long
    Dim i As Long

    Set ws1 = Sheets("Stückliste")

    For Each ws In Worksheets
        If ws.Name <> "Stückliste" Then
            LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row
            For i = 14 To LastRow
                If ws.Cells(i, 3).Value > 0 Then
                    DestLastRow = ws1.Cells(Rows.Count, 5).End(xlUp).Row + 1
                    ws.Rows(i).Copy ws1.Rows(DestLastRow)
                End If
            Next i
        End If
    Next ws

    Application.CutCopyMode = False

End Sub

Upvotes: 1

Related Questions