Чтобы скопировать значения из листа 1 в лист 2 и вставить его в нужное место, используя vba

Question

Моя цель - скопировать значения из ячеек на листе 1 "B5" и вставить их на лист 2 "C11" и ниже, если код не работает должным образом

Sub SCMPROCUREMENT()

' SUPPLY CHAIN MANAGEMENT PROCUREMENT


Worksheets("Sheet1").Select


Range("B5:B100000").Select

finalrow = Cells(Rows.Count, 2).End(xlUp).Row

For x = 5 To finalrow

If Worksheets("sheet1").Cells(x, 2).Font.Bold = False Then

Worksheets("sheet1").Select

Cells(x, 2).Select

Selection.Copy

ThisWorkbook.Worksheets("Sheet2").Range("C11").Select


ActiveSheet.Paste


End If
Next x

End Sub

Answer 1

А) ваш ThisWorkbook.Worksheets("Sheet2").Range("C11") не работает так

б) вам нужен счетчик для второго списка, в противном случае вы продолжаете перезаписывать C11

Sub SCMPROCUREMENT()

    ' SUPPLY CHAIN MANAGEMENT PROCUREMENT

    Dim count As Integer

    For x = 5 To Worksheets("Sheet1").Cells(Rows.count, 2).End(xlUp).Row

        If Worksheets("Sheet1").Cells(x, 2).Font.Bold = False Then

            Worksheets("Sheet1").Cells(x, 2).Copy

            Worksheets("Sheet2").Cells(11 + count, 3).Select
            ActiveSheet.Paste

            count = count + 1

        End If
    Next x

End Sub

Answer 2

Sub SCMPROCUREMENT()

    ' SUPPLY CHAIN MANAGEMENT PROCUREMENT

    Application.ScreenUpdating = False

    Dim count As Integer

    With Worksheets("Sheet1")

        For x = 5 To .Cells(Rows.count, 2).End(xlUp).Row

            If .Cells(x, 2).Font.Bold = False Then

                .Cells(x, 2).Copy Worksheets("Sheet2").Cells(11 + count, 3)
                count = count + 1
            End If
        Next x

    End With

    Application.ScreenUpdating = True

End Sub