Still learning vba, I have code to copy specific cells from one worksheet to another, currently coded for a specific worksheet. Need to have the code loop through all of the worksheets (to be named by users) that are not labeled Summary or Template. Could someone please, please help.
Here is the code probably could been done a little more efficiently.
Dim ws As Worksheet
Set ws = Worksheets("025426368")
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Summary")
Sheets("Summary").Select
Dim sRow As Long 'row index on source worksheet
For sRow = 1 To Range("u65536").End(xlUp).Row
ws.Cells(6, 2).Copy Destination:=DestSheet.Cells(9, 2)
ws.Cells(7, 2).Copy Destination:=DestSheet.Cells(9, 3)
ws.Cells(6, 9).Copy Destination:=DestSheet.Cells(9, 4)
ws.Cells(13, 13).Copy
DestSheet.Cells(9, 6).PasteSpecial xlPasteValues
ws.Cells(14, 13).Copy
DestSheet.Cells(9, 7).PasteSpecial xlPasteValues
ws.Cells(15, 13).Copy
DestSheet.Cells(9, 8).PasteSpecial xlPasteValues
ws.Cells(16, 13).Copy
DestSheet.Cells(9, 9).PasteSpecial xlPasteValues
ws.Cells(17, 13).Copy
DestSheet.Cells(9, 10).PasteSpecial xlPasteValues
ws.Cells(18, 13).Copy
DestSheet.Cells(9, 11).PasteSpecial xlPasteValues
ws.Cells(22, 5).Copy
DestSheet.Cells(9, 15).PasteSpecial xlPasteValues
ws.Cells(22, 7).Copy
DestSheet.Cells(9, 16).PasteSpecial xlPasteValues
ws.Cells(22, 9).Copy
DestSheet.Cells(9, 17).PasteSpecial xlPasteValues
ws.Cells(23, 5).Copy
DestSheet.Cells(9, 18).PasteSpecial xlPasteValues
ws.Cells(23, 7).Copy
DestSheet.Cells(9, 19).PasteSpecial xlPasteValues
ws.Cells(23, 9).Copy
DestSheet.Cells(9, 20).PasteSpecial xlPasteValues
ws.Cells(24, 5).Copy
DestSheet.Cells(9, 21).PasteSpecial xlPasteValues
ws.Cells(24, 7).Copy
DestSheet.Cells(9, 22).PasteSpecial xlPasteValues
ws.Cells(24, 9).Copy
DestSheet.Cells(9, 23).PasteSpecial xlPasteValues
ws.Cells(25, 5).Copy
DestSheet.Cells(9, 24).PasteSpecial xlPasteValues
ws.Cells(25, 7).Copy
DestSheet.Cells(9, 25).PasteSpecial xlPasteValues
ws.Cells(25, 9).Copy
DestSheet.Cells(9, 26).PasteSpecial xlPasteValues
ws.Cells(19, 11).Copy
DestSheet.Cells(9, 27).PasteSpecial xlPasteValues
Next sRow
End Sub
Here is the code probably could been done a little more efficiently.
Dim ws As Worksheet
Set ws = Worksheets("025426368")
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Summary")
Sheets("Summary").Select
Dim sRow As Long 'row index on source worksheet
For sRow = 1 To Range("u65536").End(xlUp).Row
ws.Cells(6, 2).Copy Destination:=DestSheet.Cells(9, 2)
ws.Cells(7, 2).Copy Destination:=DestSheet.Cells(9, 3)
ws.Cells(6, 9).Copy Destination:=DestSheet.Cells(9, 4)
ws.Cells(13, 13).Copy
DestSheet.Cells(9, 6).PasteSpecial xlPasteValues
ws.Cells(14, 13).Copy
DestSheet.Cells(9, 7).PasteSpecial xlPasteValues
ws.Cells(15, 13).Copy
DestSheet.Cells(9, 8).PasteSpecial xlPasteValues
ws.Cells(16, 13).Copy
DestSheet.Cells(9, 9).PasteSpecial xlPasteValues
ws.Cells(17, 13).Copy
DestSheet.Cells(9, 10).PasteSpecial xlPasteValues
ws.Cells(18, 13).Copy
DestSheet.Cells(9, 11).PasteSpecial xlPasteValues
ws.Cells(22, 5).Copy
DestSheet.Cells(9, 15).PasteSpecial xlPasteValues
ws.Cells(22, 7).Copy
DestSheet.Cells(9, 16).PasteSpecial xlPasteValues
ws.Cells(22, 9).Copy
DestSheet.Cells(9, 17).PasteSpecial xlPasteValues
ws.Cells(23, 5).Copy
DestSheet.Cells(9, 18).PasteSpecial xlPasteValues
ws.Cells(23, 7).Copy
DestSheet.Cells(9, 19).PasteSpecial xlPasteValues
ws.Cells(23, 9).Copy
DestSheet.Cells(9, 20).PasteSpecial xlPasteValues
ws.Cells(24, 5).Copy
DestSheet.Cells(9, 21).PasteSpecial xlPasteValues
ws.Cells(24, 7).Copy
DestSheet.Cells(9, 22).PasteSpecial xlPasteValues
ws.Cells(24, 9).Copy
DestSheet.Cells(9, 23).PasteSpecial xlPasteValues
ws.Cells(25, 5).Copy
DestSheet.Cells(9, 24).PasteSpecial xlPasteValues
ws.Cells(25, 7).Copy
DestSheet.Cells(9, 25).PasteSpecial xlPasteValues
ws.Cells(25, 9).Copy
DestSheet.Cells(9, 26).PasteSpecial xlPasteValues
ws.Cells(19, 11).Copy
DestSheet.Cells(9, 27).PasteSpecial xlPasteValues
Next sRow
End Sub
Last edited: