Copying data to a Protected workbook Extremely Slow using MACROS

powerwill

Board Regular
Joined
Sep 14, 2018
Messages
62
Office Version
  1. 365
Platform
  1. Windows
Hi All,

This is my first time, trying to work with a recorded MACRO in EXCEL 2016

I have two workbooks: A & B.

Workbook A - Has data, Is editable, with 3 sheets.
Workbook B - Has 100 forms/sheets that are protected, can only paste data into the form, doesn't show me the Sheet number.

I have recorded a MACRO, to copy the data from Workbook A (Sheet 1) to Workbook B (Active Sheet, since the sheet no. is hidden/not known), but it's extremely slow. Below is the code.

Is there anything I can do to make it faster?

VBA Code:
Sub RANDOM_PASTE()
'
' RANDOM_PASTE Macro
'
' Keyboard Shortcut: Ctrl+Shift+P
'
    Range("C2:C5").Select
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("F5:H5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("F5:H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("C7:L10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("C7:L10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("I13:I35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("I13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("O12:O19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("O12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("O22:O25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("O22:O23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("O28:O30").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("O28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("O33:O35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Windows("AIO_MACRO.xlsm").Activate
    Windows("All in one - Random Audits.xlsx").Activate
    Range("O33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Application.CutCopyMode = False
    Range("L38:L49").Select
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("L38").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Range("N46:O57").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("N46:O57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Application.CutCopyMode = False
    Range("B70:L100").Select
    Selection.Copy
    Windows("All in one - Random Audits.xlsx").Activate
    Range("B70:L100").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
    Windows("AIO_MACRO.xlsm").Activate
    Application.CutCopyMode = False
End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Is there anything I can do to make it faster?
Yes, lots. Setting calculation to manual, turning off screen refresh and turning off events (if you have any) will all help to speed things up. Additionally, using commands like Select and Activate will slow it down so editing any recorded code to remove them is always a good idea.

This is a very quick edit to your code, hopefully I got all of the ranges correct.
VBA Code:
Sub RANDOM_PASTE()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlManual

    Dim wb1 As Workbook, wb2 As Workbook, rng1 As Range, rng2 As Range

        Set wb1 = Workbooks("AIO_MACRO.xlsm")
        Set wb2 = Workbooks("All in one - Random Audits.xlsx")

        Set rng1 = wb1.Range("C2:C5,F5:H5,C7:L10,I13:I35,O12:O19,O2:O25,O28:O30,O33:O35,L38:L49,N46:O57,B70:L100")

    For Each rng2 In rng1.Areas
        rng2.Copy
        wb2.Range(rng2.Address(0, 0)).PasteSpecial Paste:=xlValues
    Next
   
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub
 
Upvote 0
Yes, lots. Setting calculation to manual, turning off screen refresh and turning off events (if you have any) will all help to speed things up. Additionally, using commands like Select and Activate will slow it down so editing any recorded code to remove them is always a good idea.

This is a very quick edit to your code, hopefully I got all of the ranges correct.
VBA Code:
Sub RANDOM_PASTE()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlManual

    Dim wb1 As Workbook, wb2 As Workbook, rng1 As Range, rng2 As Range

        Set wb1 = Workbooks("AIO_MACRO.xlsm")
        Set wb2 = Workbooks("All in one - Random Audits.xlsx")

        Set rng1 = wb1.Range("C2:C5,F5:H5,C7:L10,I13:I35,O12:O19,O2:O25,O28:O30,O33:O35,L38:L49,N46:O57,B70:L100")

    For Each rng2 In rng1.Areas
        rng2.Copy
        wb2.Range(rng2.Address(0, 0)).PasteSpecial Paste:=xlValues
    Next
  
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Thank you very much Jason for responding. I replaced mine with yours, unfortunately got this.

1603033988276.png
1603034072676.png
 
Upvote 0
Try this mod to Jason's code
Rich (BB code):
Sub RANDOM_PASTE()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlManual

    Dim wb1 As Workbook, wb2 As Workbook, rng1 As Range, rng2 As Range
  
        Set wb1 = Workbooks("AIO_MACRO.xlsm")
        Set wb2 = Workbooks("All in one - Random Audits.xlsx")

        Set rng1 = wb1.Sheets("Sheet1").Range("C2:C5,F5:H5,C7:L10,I13:I35,O12:O19,O2:O25,O28:O30,O33:O35,L38:L49,N46:O57,B70:L100")

    For Each rng2 In rng1.Areas
        rng2.Copy
        wb2.ActiveSheet.Range(rng2.Address(0, 0)).PasteSpecial Paste:=xlValues
    Next
  
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub
Change the sheet name in red if needed.
 
Upvote 0
Thank you for your help guys. Sadly I had to leave that project.

But I am working on a new one now and have this Macro on one of the working files. But this is awfully slow..is there anyth8ng you guys would recommend to make it run quicker?

Office version: 365

VBA Code:
Sub SubmitDataWAF()'' SubmitDataWAF Macro' '    ActiveCell.Offset(-2, -2).Range("A1").Select    Range(Selection, Selection.End(xlDown)).Select    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(8, -2).Range("A1").Select    Range(Selection, Selection.End(xlDown)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(4, 4).Range("A1").Select    Range(Selection, Selection.End(xlDown)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveWindow.SmallScroll Down:=39    ActiveCell.Offset(45, -6).Range("A1:A4").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(0, 2).Range("A1:A4").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(0, 2).Range("A1:A4").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(0, 2).Range("A1:A4").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _        xlNone, SkipBlanks:=False, Transpose:=True    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveWindow.SmallScroll Down:=-24    ActiveCell.Offset(-39, -1).Range("A1:B1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, -1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1").Select    Range(Selection, Selection.End(xlToRight)).Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveWindow.SmallScroll Down:=18    ActiveCell.Offset(3, -3).Range("A1:E1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 5).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:E1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 5).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:E1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 5).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:E1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:E1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    ActiveCell.Offset(0, 1).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(-4, -3).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    ActiveSheet.Paste    ActiveCell.Offset(0, 3).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveCell.Offset(-1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    ActiveCell.Offset(0, -3).Range("A1:C1").Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 3).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 3).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    Selection.End(xlToRight).Select    Selection.End(xlToLeft).Select    ActiveCell.Offset(0, 3).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(0, 3).Range("A1:C1").Select    ActiveSheet.Previous.Select    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Application.CutCopyMode = False    Selection.Copy    ActiveSheet.Next.Select    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _        :=False, Transpose:=False    ActiveCell.Offset(1, 0).Range("A1:C1").Select    Selection.End(xlToLeft).Select    ActiveCell.Select    Sheets("Quality Form").Select    ActiveWindow.SmallScroll Down:=-114    ActiveCell.Offset(-52, 7).Range("A1:A6").SelectEnd Sub
 
Upvote 0
As this is a different question, you will need to start a new thread. Thanks.

Office version: 365

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using, so that you don't have to mention it. (Don’t forget to scroll down & ‘Save’)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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