Help with Repetitive Copy and Pasting using VBA

chuibchan

New Member
Joined
Sep 13, 2014
Messages
8
<article>
Hello. First let me say thank you for your help. I'm sorry if this answer is elsewhere, but I've had troubles trying to adjust others solutions to fit my needs. Unfortunately, my skill level is that low.

What I need is to create a matrix of prices. I need to fill up every cell in the Base Price document (https://www.dropbox.com/s/wmxw3580nb5u5e1/Base Price.xls?dl=0)

By entering in certain criteria into Q_Input (https://www.dropbox.com/s/d1yr6ppak5gogje/Q_Input.xlsx?dl=0). Q_Input is part of a larger document that does all the complicated calculations but I separated it out to keep the confidential info confidential. in theory by changing 5 factors:
1. # layers
2. Lamination Type
3. Panel
4. Thickness
5. Quantity

a total is calculated and shown in cell "E6". Most likely the total won't calculate now since I separated it from the calculating part. But that is fine. I'm more concerned about copying and pasting the value from E6 into the Base price table.

I created a macros so that it will fill in the first cell by having it copy and paste the information into the table and then copy and paste the solution into the matrix. But, I don't know how to get it to do the same thing to the next cell and so on.

Here is my Macros:

Code (vb):

Sub Macro17()

Macro17 Macro

Sheets("Base Price").Select
Range("E25").Select
Selection.Copy
Sheets("Q_Input").Select
Range("F16").Select
ActiveSheet.Paste


Sheets("Base Price").Select
Range("E24").Select
Selection.Copy
Sheets("Q_Input").Select
Range("F13").Select

ActiveSheet.Paste



Sheets("Base Price").Select
Range("$C$27").Select
Selection.Copy
Sheets("Q_Input").Select
Range("C14").Select

ActiveSheet.Paste



Sheets("Base Price").Select
Range("D26").Select
Selection.Copy
Sheets("Q_Input").Select
Range("F20").Select

ActiveSheet.Paste



Sheets("Base Price").Select
Range("$C$40").Select
Selection.Copy
Sheets("Q_Input").Select
Range("C13").Select

ActiveSheet.Paste



Sheets("Q_Input").Select
Range("E6").Select
Selection.Copy
Sheets("Base Price").Select
Range("E26").Select



Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub


Any help you can give me is much appreciated!

Sincerely,
Cherry Chui
</article>
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Welcome to MrExcel.

Does this work for you?

Code:
Sub Test()
    Const FirstRow As Long = 26
    Const FirstCol As Long = 5
    Dim LastRow As Long
    Dim LastCol As Long
    Dim QtyRow As Long
    Dim RowCount As Long
    Dim r As Long
    Dim c As Long
    With Sheets("Base Price")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(FirstRow - 1, .Columns.Count).End(xlToLeft).Column
        QtyRow = 40
        RowCount = 0
        For r = FirstRow To LastRow
            For c = FirstCol To LastCol
                .Cells(25, c).Copy Sheets("Q_Input").Range("F16")
                .Cells(24, c).Copy Sheets("Q_Input").Range("F13")
                .Range("C27").Copy Sheets("Q_Input").Range("C14")
                .Range("D" & r).Copy Sheets("Q_Input").Range("F20")
                .Range("C" & QtyRow).Copy Sheets("Q_Input").Range("C13")
                .Range("E" & r).Value = Sheets("Q_Input").Range("E6").Value
            Next c
            RowCount = RowCount + 1
            If RowCount = 30 Then
                QtyRow = QtyRow + 30
                RowCount = 0
            End If
        Next r
    End With
End Sub
 
Upvote 0
Welcome to MrExcel.

Does this work for you?

Code:
Sub Test()
    Const FirstRow As Long = 26
    Const FirstCol As Long = 5
    Dim LastRow As Long
    Dim LastCol As Long
    Dim QtyRow As Long
    Dim RowCount As Long
    Dim r As Long
    Dim c As Long
    With Sheets("Base Price")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(FirstRow - 1, .Columns.Count).End(xlToLeft).Column
        QtyRow = 40
        RowCount = 0
        For r = FirstRow To LastRow
            For c = FirstCol To LastCol
                .Cells(25, c).Copy Sheets("Q_Input").Range("F16")
                .Cells(24, c).Copy Sheets("Q_Input").Range("F13")
                .Range("C27").Copy Sheets("Q_Input").Range("C14")
                .Range("D" & r).Copy Sheets("Q_Input").Range("F20")
                .Range("C" & QtyRow).Copy Sheets("Q_Input").Range("C13")
                .Range("E" & r).Value = Sheets("Q_Input").Range("E6").Value
            Next c
            RowCount = RowCount + 1
            If RowCount = 30 Then
                QtyRow = QtyRow + 30
                RowCount = 0
            End If
        Next r
    End With
End Sub


Dear Andrew,

The problem is it populates the first column and doesn't populate the correct data. Also, I let the macro run over night and it only populated the first column. I made some tweaks to the Base Price document in hopes it will help to pick up the correct data and then realized I don't know how to adjust the macros coding accordingly. If it works for the first section (IS415 A-O. I will change the rest of the document)

https://www.dropbox.com/s/gni5g0zz9kvrlhk/Base Price.xls?dl=0

But seriously thank you its definitely moving in the right direction.

Code:
Sub Test()
    Const FirstRow As Long = 26
    Const FirstCol As Long = 6
    Dim LastRow As Long
    Dim LastCol As Long
    Dim QtyRow As Long
    Dim RowCount As Long
    Dim r As Long
    Dim c As Long
    With Sheets("Base Price")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(FirstRow - 1, .Columns.Count).End(xlToLeft).Column
        QtyRow = 40
        RowCount = 0
        For r = FirstRow To LastRow
            For c = FirstCol To LastCol
                .Cells(25, c).Copy Sheets("Q_Input").Range("F16")
                .Cells(24, c).Copy Sheets("Q_Input").Range("F13")
                .Range("C27").Copy Sheets("Q_Input").Range("C14")
                .Range("D" & r).Copy Sheets("Q_Input").Range("F20")
                .Range("C" & QtyRow).Copy Sheets("Q_Input").Range("C13")
                .Range("E" & r).Value = Sheets("Q_Input").Range("E6").Value
            Next c
            RowCount = RowCount + 1
            If RowCount = 30 Then
                QtyRow = QtyRow + 30
                RowCount = 0
            End If
        Next r
    End With
End Sub
[/QUOTE]
 
Upvote 0
Looking again, I think this:

Code:
.Range("E" & r).Value = Sheets("Q_Input").Range("E6").Value

should be:

Code:
.Cells(r, c).Value = Sheets("Q_Input").Range("E6").Value
 
Upvote 0
Looking again, I think this:

Code:
.Range("E" & r).Value = Sheets("Q_Input").Range("E6").Value

should be:

Code:
.Cells(r, c).Value = Sheets("Q_Input").Range("E6").Value


A MILLION THANK YOUS! Seriously thank you.

So that tweak was what was needed. My bf took a peak and made a few more tweaks and now it runs! Here is the code in all its entirety:

Code:
Sub Macro5()
'Sub Test()
    Const FirstRow As Long = 26
    Const FirstCol As Long = 6
    Dim LastRow As Long
    Dim LastCol As Long
    Dim QtyRow As Long
    Dim RowCount As Long
    Dim r As Long
    Dim c As Long
    With Sheets("Base Price")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(FirstRow - 1, .Columns.Count).End(xlToLeft).Column
        QtyRow = 40
        RowCount = 0
        For r = FirstRow To LastRow
            For c = FirstCol To LastCol
                .Cells(25, c).Copy Sheets("Q_Input").Range("F16")
                .Cells(24, c).Copy Sheets("Q_Input").Range("F13")
                .Range("C27").Copy Sheets("Q_Input").Range("C14")
                .Range("E" & r).Copy Sheets("Q_Input").Range("F20")
                .Range("D" & QtyRow).Copy Sheets("Q_Input").Range("C13")
                .Cells(r, c).Value = Sheets("Q_Input").Range("E6").Value
            Next c
            RowCount = RowCount + 1
            If RowCount = 30 Then
                QtyRow = QtyRow + 30
                RowCount = 0
            End If
        Next r
    End With

End Sub
 
Upvote 0
A MILLION THANK YOUS! Seriously thank you.

So that tweak was what was needed. My bf took a peak and made a few more tweaks and now it runs! Here is the code in all its entirety:

Code:
Sub Macro5()
'Sub Test()
    Const FirstRow As Long = 26
    Const FirstCol As Long = 6
    Dim LastRow As Long
    Dim LastCol As Long
    Dim QtyRow As Long
    Dim RowCount As Long
    Dim r As Long
    Dim c As Long
    With Sheets("Base Price")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(FirstRow - 1, .Columns.Count).End(xlToLeft).Column
        QtyRow = 40
        RowCount = 0
        For r = FirstRow To LastRow
            For c = FirstCol To LastCol
                .Cells(25, c).Copy Sheets("Q_Input").Range("F16")
                .Cells(24, c).Copy Sheets("Q_Input").Range("F13")
                .Range("C27").Copy Sheets("Q_Input").Range("C14")
                .Range("E" & r).Copy Sheets("Q_Input").Range("F20")
                .Range("D" & QtyRow).Copy Sheets("Q_Input").Range("C13")
                .Cells(r, c).Value = Sheets("Q_Input").Range("E6").Value
            Next c
            RowCount = RowCount + 1
            If RowCount = 30 Then
                QtyRow = QtyRow + 30
                RowCount = 0
            End If
        Next r
    End With

End Sub

Actually one more question. How would I change the last row to for example 475 and change the first row? Considering how long it takes to process. Its probably better to break down the process and have 5 macros (1 for IS415, 1 for FR408 etc..)

Thank You
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,044
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top