Sub MoveIt1() Dim CopyArr As Variant, PasteArr As Variant, X As Long Dim ws As Worksheet, ws1 As Worksheet Set ws = Sheet1 Set ws1 = Sheet7 nextrow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False CopyArr = Array("H12", "H13", "A12", "A13", "A14", "A15", "A16", "A17", "A20", "H17", "H14", "H15", "H16", "E23", "B24", _ "B25", "B26", "B27", "B28", "B29", "B30", "B31", "B32", "B33", "B34", "H25", "H26", "H27", "H28", "H29", "H30", "H31", "H32", "H33", "H34") PastArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "L", "M", "N", "O", "P", "Q", "R", "S", "U", "W", "Y", "AA", "AC", "AE", _ "AG", "AI", "AK", "T", "V", "X", "Z", "AB", "AD", "AF", "AH", "AJ", "AL") For X = LBound(CopyArr) To UBound(CopyArr) ws1.Range(CopyArr(X)).Copy ws.Range(PastArr(X) & nextrow).PasteSpecial xlPasteValues Next ws.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True ws.Select End Sub
Sub MoveIt2() Dim CopyArr As Variant, PasteArr As Variant, X As Long Dim ws As Worksheet, ws1 As Worksheet Set ws = Sheet1 Set ws1 = Sheet8 nextrow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False CopyArr = Array("H12", "H13", "A12", "A13", "A14", "A15", "A16", "A17", "A20", "H17", "H14", "H15", "H16", "E23", "B24", _ "B25", "B26", "B27", "B28", "B29", "B30", "B31", "B32", "B33", "B34", "H25", "H26", "H27", "H28", "H29", "H30", "H31", "H32", "H33", "H34") PastArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "L", "M", "N", "O", "P", "Q", "R", "S", "U", "W", "Y", "AA", "AC", "AE", _ "AG", "AI", "AK", "T", "V", "X", "Z", "AB", "AD", "AF", "AH", "AJ", "AL") For X = LBound(CopyArr) To UBound(CopyArr) ws1.Range(CopyArr(X)).Copy ws.Range(PastArr(X) & nextrow).PasteSpecial xlPasteValues Next ws.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True ws.Select End Sub
Sub MoveIt3() Dim CopyArr As Variant, PasteArr As Variant, X As Long Dim ws As Worksheet, ws1 As Worksheet Set ws = Sheet1 Set ws1 = Sheet2 nextrow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False CopyArr = Array("H12", "H13", "A12", "A13", "A14", "A15", "A16", "A17", "A20", "H17", "H14", "H15", "H16", "E23", "B24", _ "B25", "B26", "B27", "B28", "B29", "B30", "B31", "B32", "B33", "B34", "H25", "H26", "H27", "H28", "H29", "H30", "H31", "H32", "H33", "H34") PastArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "L", "M", "N", "O", "P", "Q", "R", "S", "U", "W", "Y", "AA", "AC", "AE", _ "AG", "AI", "AK", "T", "V", "X", "Z", "AB", "AD", "AF", "AH", "AJ", "AL") For X = LBound(CopyArr) To UBound(CopyArr) ws1.Range(CopyArr(X)).Copy ws.Range(PastArr(X) & nextrow).PasteSpecial xlPasteValues Next ws.Columns.AutoFit Application.CutCopyMode = False Application.ScreenUpdating = True ws.Select End Sub
Sub RemoveDupes() Application.ScreenUpdating = False Range("AU2:AU" & Cells(Rows.Count, 1).End(xlUp).Row) = "=COUNTIF($A$2:$A2,A2)>1" Range("AU:AU").AutoFilter 1, "True" Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row).EntireRow.Delete Range("AU:AU").AutoFilter Range("AU:AU").ClearContents Application.ScreenUpdating = True End Sub
DON'T MISS
Good day to you,
Thank you for the respond and here is the link :
https://www.dropbox.com/s/h5wh1gc9n4p4bs3/sample.xlsx?dl=0
Thank you,
Saktivel