データがある既存の行の上に行を挿入するマクロ

Question

この作業を行うためにいくつかのVBAを操作しようとしましたが、どこにもないようです。

データを持つ行の上に新しい行を挿入し、セル1と2のデータをその新しい行にコピーするマクロを書きたいとします。

私は私が持っているものの絵を入れて、私は

追加の写真が欲しいものの写真：ここ

What I have What I need

は、私が使用したコードですが、私はそれがする必要があります次の行を続けてください：

Sub InsertRowandCopyCell1and2() 
' 
' InsertRowandCopyCell1and2 Macro 
' 
' Keyboard Shortcut: Ctrl+w 
' 
    Rows("78:78").Select 
    Selection.Insert Shift:=xlDown 
    Range("A79:B79").Select 
    Selection.Cut 
    Range("A78").Select 
    ActiveSheet.Paste 
    Rows("78:78").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorDark2 
     .TintAndShade = -9.99786370433668E-02 
     .PatternTintAndShade = 0 
    End With 
    Rows("92:92").Select 
    Selection.Insert Shift:=xlDown 
    Range("A93:B93").Select 
    Selection.Cut 
    Range("A92").Select 
    ActiveSheet.Paste 
    Rows("92:92").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorDark2 
     .TintAndShade = -9.99786370433668E-02 
     .PatternTintAndShade = 0 
    End With 
    Rows("96:96").Select 
    Selection.Insert Shift:=xlDown 
    Range("A97:B97").Select 
    Selection.Cut 
    Range("A96").Select 
    ActiveSheet.Paste 
    Rows("96:96").Select 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorDark2 
     .TintAndShade = -9.99786370433668E-02 
     .PatternTintAndShade = 0 
    End With 
End Sub 

Answer 1

これは実際には難しいかもしれません。同時に新しい行を挿入しながら一連の行を反復しようとすると、無限ループが発生します。解決策は、最初にデータ行をコレクションに格納してから、そのコレクションを反復しながら行を挿入し、データをコピーすることです。下の例があなたのために働くかどうか見てください。

更新：最初の2つの列に値がある場合にのみ、空の行を挿入するようにロジックを変更しました。これが機能するかどうか確認してください。

コード：

Sub insertRows() 

    ' first you have to store all the rows in a collection, 
    ' because if you'll iterate while adding rows your loop 
    ' will never end 
    Dim rw As Range 
    Dim cRows As New Collection 
    For Each rw In ActiveSheet.[a1:e11].Rows 
     ' only include rows that have first and second cells non-empty 
     If Len(Trim(rw.Cells(1))) > 0 And Len(Trim(rw.Cells(2))) > 0 Then 
      cRows.Add rw 
     End If 
    Next 

    ' now iterate the immutable collection of rows and copy data 
    Dim rng As Variant 
    For Each rng In cRows 
     rng.EntireRow.Insert 
     rng.Cells(1).Cut rng.Cells(1).Offset(-1) 
     rng.Cells(2).Cut rng.Cells(2).Offset(-1) 
    Next 

End Sub 

終了状態：状態の開始

Answer 2

あなたはcoのコアを得ることができるはずですマクロを記録してください。録音をオンにするだけで、必要な行を挿入します。&値を新しい行にコピーします。次に、それを汎用化する必要があります。そのショットを与えて、まだ問題がある場合は、コードを投稿して詳細なガイダンスを得てください。

アップデート：ここで私はあなたが

Sub InsertRowandCopyCell1and2() 
' 
' InsertRowandCopyCell1and2 Macro 
' 
' Keyboard Shortcut: Ctrl+w 
' 
Dim i as Long 
Dim ws as worksheet 
Set ws = ThisWorkbook.Worksheets(1) 'change to the correct index or use the sheet's name 

'Setup to iterate through the rows. NOTE: I'm assuming your data starts in row 2 & that 
' the data is continuous in Column C (i.e. if C is blank for a row, there is no data 
' from that row down) adjust the macro accordingly 
i = 3 
Do While ws.Range("C" & i - 1).value <> "" 
    'Check if the row has data in columns A & B 
    If ws.Range("A" & i - 1).value <> "" And ws.Range("B" & i - 1).Value <> "" Then 
     'Prior row has data, insert a new row BELOW the row being checked (thus why we 
     ' start on row 3 & look at row i -1 
     ws.Rows(i & ":" & i).Insert Shift:=xlDown 

     'We've just created a new row i, which we now need to move the data from row i - 1 down into 
     ws.Range("C" & i - 1 & ":E" & i - 1).Cut 
     ws.Range("C" & i).PasteSpecial xlPasteAll 

     'The row we need to check next WAS row i, but due to the insert, it's now row i + 1, 
     ' so we simply increment i by 2 (thus skipping looking at row i, the row we just created) 
     i = i + 2 
    Else 
     'Row does not indicate an insertion is necessary, simply move to the next row 
     i = i + 1 
    End If 
Loop 

End Sub 

を掲載コードを微調整したい方法です私はそれをするときにロジックを、次のいなかったので、私は、フォーマットの変更コードを取り除くでしたが、あなたが追加することができますそれは正しい条件を持っているIfステートメントで単にそれをラップするだけです。

サイドバー：可能であればコードを大幅に遅くするので、可能な限りSelect & Selection.を使用しないでください。