Copy cells from a worksheet to another worksheet with the same prefix but different suffix

[VBALearner2011]

Hi All,

Please help me with this. It will be greatly appreciated!!!!!ray:

I am working on a task which requires to copy a range from worksheets then paste to other worksheets that have the same prefix in the sheet name but different suffix. I figure it will be more efficient if I can automate this task (I just came in contact with VBA recently, but I know VBA can help me achieve this).

I know how to do copy and past for each set, but I want a code that can go through this more dynamically.

<TABLE style="WIDTH: 183pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=244 border=0><COLGROUP><COL style="WIDTH: 86pt; mso-width-source: userset; mso-width-alt: 4205" width=115><COL style="WIDTH: 97pt; mso-width-source: userset; mso-width-alt: 4717" width=129><TBODY><TR style="HEIGHT: 15pt" height=20><TD class=xl66 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 86pt; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" width=115 height=20>Copy from</TD><TD class=xl66 style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 97pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=129>Paste to</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>12335 Sale</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">12335 Sale Copy</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>24654 Sale</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">24654 Sale Copy</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>36447 Sale</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">36447 Sale Copy</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>46365 Sale</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">46365 Sale Copy</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>53358 Sale</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent">53358 Sale Copy
</TD></TR></TBODY></TABLE>

Below is the code I put together, but it does not work as I wanted.
------------------------------------------------------------

Sub CopyPaste()
Dim mySheet As Worksheet
For LSheet = 1 To ActiveWorkbook.Sheets.Count
If Right$(Sheets(LSheet).Name, 4) = "Sale" Then
Sheets(LSheet).Select
Range("A8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste: by sheet index start from 5 and increment by 4 (sheet that need to paste to are 4 sheets away from each other)
For I = 5 To 164 Step 4
Sheets(I).Select
Range("A3").Select.Paste

Next I
End If


Next LSheet
End Sub

-----------------------------------------------------

Thanks in Advance

 

[JoeMo]

Try this on a copy of your workbook:

Sub CopyToCopySheet()
Dim wb As Workbook, sh As Worksheet, lCol As Long, thisSht As Worksheet

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set wb = ThisWorkbook
Set thisSht = ActiveSheet

For Each sh In wb.Worksheets
    If LCase(Right(sh.Name, 4)) = "sale" Then
        sh.Activate
        lCol = sh.Cells(8, Columns.Count).End(xlToLeft).Column
        With Range(Cells(8, 1), Cells(8, lCol))
            .Copy
        End With
        With Sheets(sh.Name & " Copy")
            .Range("A8").PasteSpecial Paste:=xlValues
        End With
    End If
Next sh
With Application
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = False
End With
thisSht.Activate
End Sub

 

[VBALearner2011]

This code worked great!!! Thanks very much for your help!!