Copying data to a Protected workbook Extremely Slow using MACROS

P

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

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
powerwill said:
Is there anything I can do to make it faster?
Click to expand...
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
jasonb75 said:
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
Click to expand...

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.

powerwill said:
Office version: 365
Click to expand...

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
You must log in or register to reply here.

Similar threads

J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
158
shknbk2
S
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
514
jolivanes
jolivanes
P
  • Solved
Counter in For Each loop
Replies
2
Views
184
Possum17
P
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
165
pennbowl
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
298
Azamamir
A

Forum statistics

Threads
1,214,599
Messages
6,120,449
Members
448,966
Latest member
DannyC96

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