Help with Repetitive Copy and Pasting using VBA

C

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

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
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
Andrew Poulsom said:
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
Click to expand...


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
Andrew Poulsom said:
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
Click to expand...


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
chuibchan said:
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
Click to expand...

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
You must log in or register to reply here.

Similar threads

F
  • Solved
Copy paste from one Excel workbook to another with same sheet names and update dates in range
Replies
8
Views
360
Skiier89
S
M
  • Question
Macro - find (control+f) value copied earlier in process
Replies
9
Views
254
Alex Blakenburg
A
C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
344
myall_blues
myall_blues
H
  • Solved
Pasting Error when copying columns
2 3
Replies
26
Views
702
Vogateer
V
brent3162
  • Solved
VBA help with increasing row before macro runs again.
Replies
3
Views
214
jolivanes
jolivanes

Forum statistics

Threads
1,220,954
Messages
6,157,043
Members
451,394
Latest member
indrajeet_rajput

Share this page

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