Help with Macros in VBA

X

xLogan108

New Member
Joined
Jun 1, 2015
Messages
23
My code that I'm working with is:
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A1")
Sheets("Sheet2").Range("F4").Copy Destination:=Sheets("Sheet1").Range("F1")
Sheets("Sheet2").Range("F8").Copy Destination:=Sheets("Sheet1").Range("G1")



I am new to macros, and I need a way to speed up this process, since:

Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A1")
Sheets("Sheet2").Range("F4").Copy Destination:=Sheets("Sheet1").Range("F1")
Sheets("Sheet2").Range("F8").Copy Destination:=Sheets("Sheet1").Range("G1")


The green part of the code must go to the letter U, and the red part must go to 16, ie x16.


So here is how it looks now:
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A1")
Sheets("Sheet2").Range("F4").Copy Destination:=Sheets("Sheet1").Range("F1")
Sheets("Sheet2").Range("F8").Copy Destination:=Sheets("Sheet1").Range("G1")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A2")
Sheets("Sheet2").Range("G4").Copy Destination:=Sheets("Sheet1").Range("F2")
Sheets("Sheet2").Range("G8").Copy Destination:=Sheets("Sheet1").Range("G2")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A3")
Sheets("Sheet2").Range("H4").Copy Destination:=Sheets("Sheet1").Range("F3")
Sheets("Sheet2").Range("H8").Copy Destination:=Sheets("Sheet1").Range("G3")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A4")
Sheets("Sheet2").Range("I4").Copy Destination:=Sheets("Sheet1").Range("F4")
Sheets("Sheet2").Range("I8").Copy Destination:=Sheets("Sheet1").Range("G4")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A5")
Sheets("Sheet2").Range("J4").Copy Destination:=Sheets("Sheet1").Range("F5")
Sheets("Sheet2").Range("J8").Copy Destination:=Sheets("Sheet1").Range("G5")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A6")
Sheets("Sheet2").Range("k4").Copy Destination:=Sheets("Sheet1").Range("F6")
Sheets("Sheet2").Range("k8").Copy Destination:=Sheets("Sheet1").Range("G6")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A7")
Sheets("Sheet2").Range("l4").Copy Destination:=Sheets("Sheet1").Range("F7")
Sheets("Sheet2").Range("l8").Copy Destination:=Sheets("Sheet1").Range("G7")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A8")
Sheets("Sheet2").Range("m4").Copy Destination:=Sheets("Sheet1").Range("F8")
Sheets("Sheet2").Range("m8").Copy Destination:=Sheets("Sheet1").Range("G8")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A9")
Sheets("Sheet2").Range("n4").Copy Destination:=Sheets("Sheet1").Range("F9")
Sheets("Sheet2").Range("n8").Copy Destination:=Sheets("Sheet1").Range("G9")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A10")
Sheets("Sheet2").Range("o4").Copy Destination:=Sheets("Sheet1").Range("F10")
Sheets("Sheet2").Range("o8").Copy Destination:=Sheets("Sheet1").Range("G10")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A11")
Sheets("Sheet2").Range("p4").Copy Destination:=Sheets("Sheet1").Range("F11")
Sheets("Sheet2").Range("p8").Copy Destination:=Sheets("Sheet1").Range("G11")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A12")
Sheets("Sheet2").Range("q4").Copy Destination:=Sheets("Sheet1").Range("F12")
Sheets("Sheet2").Range("q8").Copy Destination:=Sheets("Sheet1").Range("G12")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A13")
Sheets("Sheet2").Range("r4").Copy Destination:=Sheets("Sheet1").Range("F13")
Sheets("Sheet2").Range("r8").Copy Destination:=Sheets("Sheet1").Range("G13")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A14")
Sheets("Sheet2").Range("s4").Copy Destination:=Sheets("Sheet1").Range("F14")
Sheets("Sheet2").Range("s8").Copy Destination:=Sheets("Sheet1").Range("G14")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A15")
Sheets("Sheet2").Range("t4").Copy Destination:=Sheets("Sheet1").Range("F15")
Sheets("Sheet2").Range("t8").Copy Destination:=Sheets("Sheet1").Range("G15")
'
Sheets("Sheet2").Range("A8:E8").Copy Destination:=Sheets("Sheet1").Range("A16")
Sheets("Sheet2").Range("u4").Copy Destination:=Sheets("Sheet1").Range("F16")
Sheets("Sheet2").Range("u8").Copy Destination:=Sheets("Sheet1").Range("G16")




How can I streamline this, for example a loop maybe, so I do not have to do this repeatedly, because after I have the above part streamlines, I then have to go through and do it for the rest of the rows of ranges I have in my sheet, so A8:E8, A9:E9, A10:E10, etc.

I hope I am explaining this good enough!
 
Last edited:

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
For more information and maybe better explaining, here is what I have,

02030405060708091011121314151617
PERFORMANCE BOND AND PAVEMENT BOND1LS100000000000000000000

<tbody>
</tbody>


Going to:

10PERFORMANCE BOND AND PAVEMENT BOND1LS10000020
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000030
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000040
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000050
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000060
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000070
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000080
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000090
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000100
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000110
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000120
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000130
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000140
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000150
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000160
10PERFORMANCE BOND AND PAVEMENT BOND1LS10000170

<tbody>
</tbody>
 
Upvote 0
Give this a try
Code: 
Sub copyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
    For i = 1 To 16
        sh2.Range("A8:E8").Copy sh1.Cells(i, 1)
        sh2.Cells(4, i + 5).Copy sh1.Cells(i, 6)
        sh2.Cells(8, i + 5).Copy sh1.Cells(i, 7)
    Next
End Sub
 
Upvote 0
JLGWhiz said:
Give this a try
Code: 
Sub copyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
    For i = 1 To 16
        sh2.Range("A8:E8").Copy sh1.Cells(i, 1)
        sh2.Cells(4, i + 5).Copy sh1.Cells(i, 6)
        sh2.Cells(8, i + 5).Copy sh1.Cells(i, 7)
    Next
End Sub
Click to expand...
Ok, that worked!

Now, to move onto my next row of information, do I have to create a new sub? Or just change the values and recopy the code after next? For example, I need to run that for A9:E9, A10:E10, etc.
 
Last edited:
Upvote 0
I would have to change the number 16 then, because I want to keep this data, and do it again for my next set, so it would be another 16, and so on and so forth.
 
Upvote 0
mas123 said:
can you explain what you want clearly please!
Click to expand...
It's tough, I know! I'm sorry.

Ok, so JLGWhiz works perfect. But, i have more data now to go below that.

What I have:

02030405060708091011121314151617
10PERFORMANCE BOND AND PAVIMENT BOND1LS100000000000000000000
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500005000000000000000
30CONSTRUCTION LAYOUT1LS2000000000200000000000000
40INLET FILTER TYPE 227UN5291.6265.232025287.353900000265.23000000
50CONCRETE WASHOUT SYSTEM1LS60000000020000000000000
60OIL ONLY EMERGENCY SPILL KIT1UN100008500000000000000
70BREAKAWAY BARRICADE150UN0.01007623.750000000000000
80DRUM125UN0.010064200000000000000
90TRAFFIC CONE125UN0.010014980000000000000
100CONSTRUCTION SIGNS1500SF0.01000007182.380000000000
110TRAFFIC TRUCK2UN50000000000000000000
120PORTABLE VARIABLE MESSAGE SIGN2UN150000000000000000000
130TEMPORARY TRAFFIC STRIPES, 4" THICK7000LF.0.220000015400000000000
140TEMPORARY PAVEMENT MARKINGS300SF1.7000005100000000000
150TEMPORARY PAVEMENT MARKERS250UN1000002500000000000
160TRAFFIC DIRECTOR, FLAGGER550HR0.019112.58288.4608979.821000008288.46000000
170FUEL PRICE ADJUSTMENT1LS35000035000000000000000
180ASPHALT PRICE ADJUSTMENT1LS1980000198000000000000000
190CLEARING SITE1LS5000010993.959136.42000010388.330214700009136.4000000
200STRIPPING1AC5001535.841379.501504.47000001379.5000000
210EXCAVATION, TEST PIT100CY0.013110.62785.6703042.789000002785.67000000
220EXCAVATION, UNCLASSIED8165CY110000095938.750000000000
230REMOVAL OF PAVEMENT25427SY100000095351.250000000000
240DENSE-GRADED AGGREGATE BASE COURSE, 6" THICK26535SY500000152576.30000000000
250HMA MILLING, 3" OR LESS750SY15468.18421.960459.35960450000421.96000000
260POLYMERIZED JOINT ADHESIVE15000LF.0.51749.61591.3922501724.129000001591.39000000
270TACK COAT2600GL0.0100260000000000000
280PRIME COAT6500GL0.0100650000000000000
290HMA 12.5M64 SURFACE COURSE2924TON9413861.5411580.25013129.320000011580.25000000
300HMA 19M64 INTERMEDIATE4387TON8821553.418019.32020421.630000018019.32000000
310HMA 25M64 BASE COURSE5848TON8225864.0821623.2024505.960000021623.2000000
320RECONSTRUCTED INLET, TYPE B, USING NEW CASTING3UN800933.18835.712250912.841300000835.71000000
330RECONSTRUCTED MANHOLE, USING NEW CASTING3UN800933.18835.711155912.841300000835.71000000
340RESET EXISTING CASTING11UN1001332.61197.665501305.749000001197.66000000
350BICYCLE SAFE GRATE7UN400544.36487.481365532.484300000487.48000000
360CURB PIECE18UN4001776.81596.8929701741.003000001596.89000000
370CONCRETE SIDEWALK, 4" THICK3837SY50000001918500000000000
380CONCRETE DRIVEWAY, 6" THICK1011SY5800000586380000000000
390DETECTABLE WARING SURFACE48SY2000000096000000000000
400CONCRETE GUTTER, 8" THICK1108SY76.500360000797760000000000
4109" X 16" CONCRETE VERTICAL CURB6621LF.19000001257990000000000
420CURB PAINTING, YELLOW4020LF.1.40000056280000000000
430TRAFFIC STRIPES, 4"11150LF.0.380000042370000000000
440TRAFFIC MARKINGS5730SF2.450000014038.50000000000
450REMOVAL OF TRAFFIC STRIPES1000LF0.5000005000000000000
460REMOVAL OF TRAFFIC MARKINGS500SF20000010000000000000
470REGULATORY AND WARNING SIGN210SF350000073500000000000
480RESET WATER METER BOX4UN400444.2399.22200435.249600000399.22000000
490RESET FIRE HYDRANT2UN1500767.92689.75500752.235200000689.75000000
500WATER. SERVICE CONNECTION15UN1001919.81724.3825001880.591000001724.38000000
510RESET WATER VALVE BOX23UN150857.91766.490838.276800000766.49000000
520RESET SANITARY SEWER CLEANOUT4UN300370.16332.68200362.702800000332.68000000
530SANITARY SEWER SERVICE CONNECTION15UN1001919.81724.3825001880.591000001724.38000000
540RECON MANHOLE, SANITARY NEW CASTING3UN10001244.241114.2711551217.117000001114.27000000
550RESET SANITARY MANHOLE13UN6002665.22395.336502611.503000002395.33000000
560GAS SERVICE CONNECTION25UN1014398.512932.81750014104.410000012932.81000000
570RESET GAS VALVE BOX27UN1501007.11899.80984.06700000899.8000000
5803" RIGID NONMETALLIC CONDUIT1685LF4900000825650000000000
59018X36 JUNCTION BOX26UN174000000452400000000000
600FOUNDATION, TYPE SPF6UN14000000084000000000000
610GROUND WIRE, N0.8 AWG2235LF1000002212.650000000000
620MULTIPLE LIGHTING WIRE, NO. 8 AWG2185LF2000004435.550000000000
630PEDESTRIAN SIGNAL STANDARD6UN8750000052980000000000
640TRAFFIC SIGNAL CABLE, 5 CONDUCTOR9755LF2.20000021363.450000000000
650TRAFFIC SIGNAL HEAD36UN154000000554400000000000
660PEDESTRIAN SIGNAL HEAD20UN100000000200000000000000
670FERTILIZING AND SEEDING, TYPE F50SY100000500000000000
680SODDING492SY203071.68275911073008.941000002759000000
690FIBER MULCHING50SY100000500000000000
700SHREDDED HARDWOOD BARK MULCHING34SY40444.2399.220435.2496068000399.22000000
710MOWING492SY10000000000000000
9500SSA ASPHALT1LS000539547.50000000000000
9501SSA DGA, ETC.1LS00000000000000000
9502SSI ASPHALT1LS00000000000000000
9503SSI DGA, ETC.1LS00000000000000000
9504ROAD MTRLS - OUTSIDE VENDORS1LS00000000000000000
9987OH ADJUSTMENT1LS00000000000000000
9988INSURANCE CLAIMS1LS00000000000000000
9989LEGAL EXPENSES1LS00000000000000000
9990RAIN DAY1LS00000000000000000
9991PUNCHLIST1LS00000000000000000
9992STREET SWEEPER1LS00000000000000000
9993All OWNED EQUIPMENT1LS00000000000000000
9994JOB SPECIFIC INSURANCE1LS00000000000000000
9995SMALL TOOLS (LOWES)1LS00000000000000000
9996ADDONS1LS00000000024337.040000000
9997BOND1LS0000000011644.7800000000
9998HAULING1LS000000096037.2000000000
9999UNAPPROVED INVOICES1LS00000000000000000

<tbody>
</tbody>




Going to:

10PERFORMANCE BOND AND PAVIMENT BOND1LS10000020
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000030
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000040
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000050
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000060
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000070
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000080
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000090
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000100
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000110
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000120
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000130
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000140
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000150
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000160
10PERFORMANCE BOND AND PAVIMENT BOND1LS10000170
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500020
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500030
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS50004500
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500050
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500060
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500070
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500080
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500090
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500100
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500110
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500120
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500130
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500140
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500150
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500160
20BAR CHART PROGRESS SCHEDULE AND UPDATE1LS500170

<tbody>
</tbody>


and to have it keep filling in the fields basically. I am not sure how to repeat that code he provided for each set of rows of data I have, pulling from "what I have" above, in the first table.
 
Upvote 0
Using @JLGWhiz code, I have this so far that is working, but still time consuming. Idk if there is a quicker way now that I have explained it better?

Sub copyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
For i = 1 To 16
sh2.Range("A8:E8").Copy sh1.Cells(i, 1)
sh2.Cells(4, i + 5).Copy sh1.Cells(i, 6)
sh2.Cells(8, i + 5).Copy sh1.Cells(i, 7)
Next
For i = 17 To 32
sh2.Range("A9:E9").Copy sh1.Cells(i, 1)
sh2.Cells(4, i - 11).Copy sh1.Cells(i, 6)
sh2.Cells(9, i - 11).Copy sh1.Cells(i, 7)
Next
For i = 33 To 48
sh2.Range("A10:E10").Copy sh1.Cells(i, 1)
sh2.Cells(4, i - 27).Copy sh1.Cells(i, 6)
sh2.Cells(10, i - 27).Copy sh1.Cells(i, 7)
Next
For i = 49 To 64
sh2.Range("A11:E11").Copy sh1.Cells(i, 1)
sh2.Cells(4, i - 43).Copy sh1.Cells(i, 6)
sh2.Cells(11, i - 43).Copy sh1.Cells(i, 7)
Next
 
Last edited:
Upvote 0
Can you attach a file to edit it.
I think you want to repeat every row for X times that display as the top row 2,3,4,5,6, .... etc
and show the number under this X after it
is this what you want??
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
VBA Help: Retaining Hyperlinks
Replies
0
Views
277
NeoSez
N
E
  • Solved
VBA code not working
2
Replies
14
Views
216
Exceliscool123456789
E
B
  • Solved
VBA Code overwrites data
Replies
6
Views
265
dmt32
D
C
  • Solved
VBA to Compare two different worksheets and copy missing rows
2
Replies
10
Views
2K
cscotty
C
A
  • Solved
Cannot get copy to paste to last open row
Replies
9
Views
337
alwynb
A

Forum statistics

Threads
1,203,602
Messages
6,056,213
Members
444,850
Latest member
dancasta7

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