Copy data, from a range input by user, to determined template

Question

I recorded a macro to create one template from a certain table of data.

The issues are:

The macro is limited to 44 rows (sometimes I deal with more than 5000):
would like the user insert the range and run the copy paste for that range.
The code is long and complex as it was recorded:
would like to clean it up.

I tried to implement a range input message. I don't know how to then use that range to run the copy paste.

Sub Macro1()
    '
    ' Macro1 Macro
    '
    
    '
        Range("A3:D3").Select
        Selection.Copy
        Range("W3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("E3:H3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("W4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("I3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("S3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("R4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("J3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("Q3:Q4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("W3:W4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("P3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("W3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("AF4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("W4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("AF3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("AA3:AE4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("AA5").Select
        ActiveSheet.Paste
        Range("Q8").Select
End Sub

How the data are displayed and how I need to have those

The macro runs, but only for limited rows. I want it to run within the range specified by the user.

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). • Also without proper example data (see [mcve]) it is impossible to understand what exactly you are trying to do. — Pᴇʜ, Aug 01 '19 at 09:19
@Pᴇʜ Thats a recorded Macro I think thats why tons of Select are used.. ;). user11868031 : **Select** will make your code slower thats why we recommend you to not use **Select**. — TourEiffel, Aug 01 '19 at 09:40
@Dorian I'm aware of that, but that doesn't change anything ;) And as long as he doesn't explain the logic behind the copy actions (or show an example) it is pretty impossible to write an answer. — Pᴇʜ, Aug 01 '19 at 09:42
@user11868031 May I Ask you to have a look to my [Answer](https://stackoverflow.com/a/57305899/11167163) . If you are looking for non fixed cell like P3 but P3 P4 P5 and so on for exemple pls watch the edit. — TourEiffel, Aug 01 '19 at 09:57
@Pᴇʜ - I would like the user to input the range and within that range (or starting from A3) to copy the yellow cells (A3:D3) and paste it on W3:Z3 then copy green cells (E3:H3) and past in W4:Z4), then blue cell (I3) needs to be copied in S3 & R4 then J3 copied to Q3: Q4. W3:W4 copied to P3:P4 W3 copied to AF4 & W4 copied to AF3 last AA3 : AD4 copied to AA5 repeat until end (empty cell/end of range) — user11868031, Aug 01 '19 at 11:30
@user11868031 if your issue is solved may I ask you to accept [this answer](https://stackoverflow.com/a/57305899/11167163) — TourEiffel, Sep 26 '19 at 09:32

TourEiffel · Answer 1 · 2019-08-01T10:02:08.547

Maybe just use a For Each And try to avoid Select

The defined Range would Be rng.

Sub Macro1()    
Dim rng As Range, cell As Range
Set rng = Range("A3:A15")
For Each cell In rng

    Range("A3:D3").Copy
    Range("W3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E3:H3").copy
    'Application.CutCopyMode = False
    Range("W4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I3").Copy
    'Application.CutCopyMode = False

    Range("S3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J3").Copy
    'Application.CutCopyMode = False
    Range("Q3:Q4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W3:W4").Copy
    'Application.CutCopyMode = False
    Range("P3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W3").Copy
    'Application.CutCopyMode = False
    Range("AF4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W4").Copy
    'Application.CutCopyMode = False

    Range("AF3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AA3:AE4").Copy
    'Application.CutCopyMode = False

    'Range("AA5").Select
    ActiveSheet.Paste
    'Range("Q8").Select

Next cell
End Sub

Note : That I think that Application.CutCopyMode = False Is not needed and can be deleted.. Tahts Why I Set them As Comment.

Edit : After reading your comment on Mikku's post I would propose stuff like that

Sub Macro1()
Dim rng As Range, cell As Range
Set rng = Range("A3:A15")
For Each cell In rng

    Range("A" & cell.Row & ":D" & cell.Row).Copy
    Range("W" & cell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E" & cell.Row & ":H" & cell.Row).Copy

    Range("W" & cell.Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I" & cell.Row).Copy
    Range("S" & cell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R" & cell.Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J" & cell.Row).Copy
    Range("Q" & cell.Row & ":Q" & cell.Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W" & cell.Row & ":W" & cell.Row + 1).Copy
    Range("P" & cell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W" & cell.Row).Copy
    Range("AF" & cell.Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("W" & cell.Row + 1).Copy
    Range("AF" & cell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AA" & cell.Row & ":AE" & cell.Row + 1).Copy
    'Range("AA5").Select
    ActiveSheet.Paste
    'Range("Q8").Select
Next cell
End Sub

Mikku · Answer 2 · 2019-08-01T09:32:55.323

Your code can be Reduced to:

Sub Macro1()

    Range("A3:D3").Copy
    Range("W3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("E3:H3").Copy
    Range("W4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("I3").Copy
    Range("S3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("R4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("J3").Copy
    Range("Q3:Q4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("W3:W4").Copy
    Range("P3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("W3").Copy
    Range("AF4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("W4").Copy
    Range("AF3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("AA3:AE4").Copy
    Range("AA5").Paste
    Range("Q8").Select

End Sub

It's better to avoid use of Select in VBA. Direct Referencing is Ideal.

If you have a Pattern of how you are copying the Cells, then this can be used to deal with Dynamic range, and can be scaled to work with 5000 Rows.

[I already deleted Select Statment](https://stackoverflow.com/a/57305899/11167163) — TourEiffel, Aug 01 '19 at 09:32
@Dorian , You can also avoid so many `Application.CutCopyMode = False` — Mikku, Aug 01 '19 at 09:34
Thanks @Mikku , the pattern is always the same just going one row down, until empty one. — user11868031, Aug 01 '19 at 09:41
Yes , Then form a Logic or mapping and include this code in a Loop. — Mikku, Aug 01 '19 at 09:52

Copy data, from a range input by user, to determined template

2 Answers2