我該如何讓每個第三排的相對宏運行？

-1

歡迎所有建議我是新手。

我做了一個很長的（和低效宏來移動數據。）

它工作正常移動分三路進入3行跨了好幾次。問題是我需要它適用於每行約1000行的第4行。

我想我正在尋找一個循環..不完全確定。也會喜歡一種引用的方式，所以我不需要再重複一遍，因爲它會放慢速度。

Sub FullMacro() 
 

 

 
'Copy info over 
 
    Cells.Select 
 
    Selection.Copy 
 
    Sheets.Add After:=Sheets(Sheets.Count) 
 
    Cells.Select 
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
 
     :=False, Transpose:=False 
 
     
 
' Deletes Top Row 
 
    Rows("1:35").Select 
 
    Selection.Delete Shift:=xlUp 
 
     
 
' InsertColumns Macro 
 
    Columns("B:B").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    Columns("z:z").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    Columns("AX:AX").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    Selection.Insert Shift:=xlToRight 
 
    Columns("BA:BA").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    Selection.Insert Shift:=xlToRight 
 
    Columns("BE:BE").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    Columns("BG:BG").Select 
 
    Selection.Insert Shift:=xlToRight 
 
    
 
'This moves the titles to a single long row 
 

 
    Range("A2").Select 
 
    Selection.Cut Destination:=Range("B1") 
 
    Range("A3").Select 
 
    Selection.Cut Destination:=Range("C1") 
 
    Range("D2").Select 
 
    Selection.Cut Destination:=Range("E1") 
 
    Range("D3").Select 
 
    Selection.Cut Destination:=Range("F1") 
 
    Range("K2").Select 
 
    Selection.Cut Destination:=Range("L1") 
 
    Range("K3").Select 
 
    Selection.Cut Destination:=Range("M1") 
 
    Range("R3").Select 
 
    Selection.Cut Destination:=Range("T1") 
 
    Range("T1").Select 
 
    Range("Y2").Select 
 
    Selection.Cut Destination:=Range("Z1") 
 
    Range("Y3").Select 
 
    Selection.Cut Destination:=Range("AA1") 
 
    Range("AB2").Select 
 
    Selection.Cut Destination:=Range("AC1") 
 
    Range("AB3").Select 
 
    Selection.Cut Destination:=Range("AD1") 
 
    Range("AJ2").Select 
 
    Selection.Cut Destination:=Range("AK1") 
 
    Range("AJ3").Select 
 
    Selection.Cut Destination:=Range("AL1") 
 
    Range("AM2").Select 
 
    Selection.Cut Destination:=Range("AN1") 
 
    Range("AM3").Select 
 
    Selection.Cut Destination:=Range("AO1") 
 
    Range("AO1").Select 
 
    Range("AS2").Select 
 
    Selection.Cut Destination:=Range("AT1") 
 
    Range("AS3").Select 
 
    Selection.Cut Destination:=Range("AU1") 
 
    Range("AW2").Select 
 
    Selection.Cut Destination:=Range("AX1") 
 
    Range("AW3").Select 
 
    Selection.Cut Destination:=Range("AY1") 
 
    Range("AZ2").Select 
 
    Selection.Cut Destination:=Range("BA1") 
 
    Range("AZ3").Select 
 
    Selection.Cut Destination:=Range("BB1") 
 
    Range("BD2").Select 
 
    Selection.Cut Destination:=Range("BE1") 
 
    Range("BF2").Select 
 
    Selection.Cut Destination:=Range("BG1") 
 
    Range("BG1").Select 
 
    
 
' Deletes the colums we don't need 
 
    
 
    Columns("H:J").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("L:N").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("M:M").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("N:Q").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("T:X").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("Z:AB").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
    Columns("AC:AC").Select 
 
    Selection.Delete Shift:=xlToLeft 
 
      
 
' Deletes the rows which used to have the titles in them 
 
    Rows("2:3").Select 
 
    Selection.Delete Shift:=xlUp 
 
    Range("A1").Select 
 
      
 
End Sub 
 

 

 
Sub Mover() 
 

 
'Moves the actual contents into the single row formatt 
 

 
    Range("A1").Select 
 
    ActiveCell.Offset(2, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(0, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 1).Range("A1") 
 
    ActiveCell.Offset(-1, 2).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(0, 2).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    
 
End Sub 
 

 
'At the moment I have to repeat downwards by selecting a new active cell and running again. This is what I want to fix. 
 

 
    Sub looping() 
 
    Range("A5").Select 
 
    
 
    ActiveCell.Offset(2, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(0, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 1).Range("A1") 
 
    ActiveCell.Offset(-1, 2).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 3).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(1, 0).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-2, 2).Range("A1") 
 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1") 
 
    ActiveCell.Offset(0, 2).Range("A1").Select 
 
    Selection.Cut Destination:=ActiveCell.Offset(-1, 1).Range("A1")

來源

2014-10-16 Tara Jacob

我失去跟蹤的什麼在你的代碼很快所以敢肯定，我不明白你的問題的嚴重程度怎麼回事？我知道它應該在評論中，但我沒有足夠的代表。

我認爲每第四行是由於移動列成行？如果是這樣，你可以顛倒順序，並從底部列開始向上移動。例如起見，我將它移動到一個新的工作表，但可以快速修復：

Sub ColumnsToRow() 

    Set oldWs = ActiveSheet 


    'Assuming you want to start in the active selected cell, if it is always a fixed starting point then this should be updated 
    'Row and Column index of activecell 
    vcol = ActiveCell.Column 
    vRow = ActiveCell.Row 

    'get the last row in the selected column 
    maxLastRow = oldWs.UsedRange.Rows.Count '~~> the last row index can not be higher that max row index in the sheet 
    Set veryLastIndex = oldWs.Range(oldWs.Cells(maxLastRow + 1, vcol), oldWs.Cells(maxLastRow + 1, vcol)) '~~> sets the range object to the cell indexed one higher than the max row index 

    lastRowInColumn = veryLastIndex.End(xlUp).Row '~~> go up from the veryLastIndex 

    Set newWs = Worksheets.Add 

    For i = lastRowInColumn To vRow Step -1 

     'insert two rows below 
     newWs.Cells(i, vcol).Offset(1).EntireRow.Insert 
     newWs.Cells(i, vcol).Offset(1).EntireRow.Insert 
      'move the cells into the newly created rows 
      For j = 0 To 2 
       oldWs.Cells(i, vcol + j).Copy Destination:=newWs.Cells(i + j, vcol) 
      Next   
    Next 

End Sub

如果你可以添加更多的描述，也許之前的截圖 - >後，將是巨大的。

來源

2014-10-16 11:57:59

我該如何讓每個第三排的相對宏運行？

回答

相關問題