#1
|
|||
|
|||
Copy Paste Special Loop to End of Col A
Need help adding the functionality to loop through the copy/paste Special Transpose process until the end of Column A data to complete.
Code:
Sub Macro2_CopyPasteTRANSPOSE() ' 'copy paste data and paste special Transpose, loop til end of Col A Range("A1:A6").Copy Range("B6").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True ActiveWindow.SmallScroll Down:=8 Range("A9:A14").Copy Range("B9").Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True ActiveWindow.SmallScroll Down:=8 'need to know how to loop - continue going down til' end of column A ( 'disable marching ants around copied range Application.CutCopyMode = False End Sub |
#2
|
|||
|
|||
This should get you started
Code:
Sub Macro2_CopyPasteTRANSPOSE() Dim i As Long Dim x As Long: x = 6 Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 1 To LastRow Step 8 Range("A" & i).Resize(6).Copy Range("B" & x).PasteSpecial xlPasteAll, , , Transpose:=True x = x + 3 Next i Application.CutCopyMode = False Application.ScreenUpdating = True End Sub |
#3
|
|||
|
|||
Hello ChrisOK
Is it reasonable to think that the paste location would always be either on the same row as the sixth of the six copied cells or on the same row as the first of the six copied cells and not a repeating "sixth-then-first" pattern as your post seems to indicate ? |
#4
|
|||
|
|||
Thx @JeffreyBrown & @NoSparks for the replies - I finally had time to get back on this and tested Jeff's. It provided unexpected results - here's why.. (and more info that should help clarify)..
Data pattern is repetitive all the way down column A. (it's only column w/ data) A1:A6 is populated, the following 2 rows are blank, pattern repeats A9:A14 is populated, 2 blanks follow, A17:A22 populated...etc Needed to select A1:A6 and paste it adjacently TRANSPOSEd (B1:G1) with the intent to delete those (now) un-needed rows 2 through 6 plus blank rows found between each dataset A9:A14 paste it adjacently (B9:G9) then delete the un-needed rows 10 through 16 A17:A22 paste it adjacently (B17:G17) then delete the un-needed rows 18 through 24 The sample code I posted was pasting into B6 which was not wanted.. Definitely needed to be pasted along the top row of existing data... (if it starts on A9 then yes, paste should also start on row 9 in Col B to right) Thanks for asking for that clarification NoSparks - I think the above expanded info is more clear on the intent and hope that helps with what solution might be available.. |
#5
|
|||
|
|||
Based on your description, I think this does what you need! Since there isn't a workbook example, I can only say it works on my test sheet and with your instructions.
Code:
Sub CopyPasteTranspose() Dim i As Long Dim LastRow As Long Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'Change Worksheet to suit Application.ScreenUpdating = False With ws LastRow = .Range("A" & .Rows.Count).End(xlUp).Row .Rows("1:1").Insert Shift:=xlDown .Range("H1").Value = "Hdr" .Range("H2:H" & .Range("A" & .Rows.Count).End(xlUp).Row).Formula = "=COUNTIF($A$2:A2,A2)" For i = 2 To LastRow Step 8 .Range("A" & i).Resize(6).Copy .Range("B" & i).PasteSpecial xlPasteAll, , , Transpose:=True Next i With .Range("H1", .Range("H" & .Rows.Count).End(xlUp)) .AutoFilter Field:=1, Criteria1:=">1", Criteria2:="0", Operator:=xlOr .Offset(1).EntireRow.Delete .AutoFilter End With .Rows("1:1").Delete Shift:=xlUp .Columns("H:H").EntireColumn.Delete End With Application.Goto [A1] Application.CutCopyMode = False Application.ScreenUpdating = True End Sub |
#6
|
|||
|
|||
@jeffreybrown -- Created a test file to show what the outcome was following running the last chunk of code... feel free to download/re-run on the original (2 tabs) 1 shows original, 1 shows the outcome after running..
File attached -- Thank you again for looking at this! Last edited by ChrisOK; 01-19-2020 at 09:40 PM. Reason: attach file |
#7
|
|||
|
|||
You neglected to indicate what the desired results would look like
Don't think you attached the file you think you did. |
#8
|
|||
|
|||
here's my interpretation of the description given in post #4
Code:
Sub CopyPasteTRANSPOSE_v3() Dim LastRow As Long, i As Long, ws As Worksheet Set ws = Sheets("Sheet1") With ws LastRow = .Range("A" & Rows.Count).End(xlUp).Row ' THE LOOP For i = 1 To LastRow Step 8 .Range("A" & i).Resize(6).Copy .Range("B" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Next i ' REMOVE ROWS .Range("B1:B" & LastRow).SpecialCells(xlBlanks).EntireRow.Delete ' POSITION THE CURSOR Application.Goto .Range("A1") End With End Sub |
#9
|
|||
|
|||
Sorry about that - See updated attachment - 2 more tabs -
one showing how the copy/paste/transpose should look (Step1) one showing how the end result would look after the blank lines got deleted along with the no long needed remaining data set rows UPDATED: NOSPARKS - just saw and added your last block in post #8 and tested it -- to find it appears to be working great! Awesome!! Thank you, I've run it on the real data and find it's working there too! All of the Inventory in the large data table looks perfect! Thanks again! (and thx Jeffrey for your help too!) PS - I was wondering how it was going to be written to locate both the extra rows of data (no longer needed) AND the blanks for deletion -- .......I like the simplicity of just looking for blanks in Col B and deleting whole row based on that! |
Tags |
copy paste special loop |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Loop through files and Copy Table Row and Paste into Different Document | spiderman1369 | Word VBA | 2 | 10-15-2014 08:30 AM |
Paste Special: Copy and Paste Formatting Only? | tinfanide | Word | 6 | 03-06-2013 12:21 AM |
DOCVARIABLE copy paste special | cyndor | Word | 2 | 04-06-2012 03:57 AM |
special copy/paste | iconofsin | Excel | 1 | 09-15-2010 12:10 AM |
Copy and paste special | Dace | Excel | 2 | 02-16-2009 12:18 PM |