Excel貼り付けの絵を列として繰り返す

Question

私は類似のマクロに提案されているコードのいくつかを試しました。

列Lのセルの情報を列Mの図として個別に貼り付ける必要があります。何百という項目のそれぞれについてこれを何度も何度も繰り返す必要はありません。

ループやリピートなしでは次のようになります。ちょうど操作を2回行う。

Sub pasteaspicture() 


pasteaspicture Macro 

    Range("L3").Select 
    Selection.Copy 
    Range("M3").Select 
    ActiveSheet.Pictures.Paste.Select 
    Range("L4").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Range("M4").Select 
    ActiveSheet.Pictures.Paste.Select 
End Sub 

ありがとうございます。

Answer 1

このコードは、行3から列Lの最後までループする必要があります。そうでない場合は、編集することができます。

Application.screenupdating = False 
With ActiveSheet 
    LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row 
End With 

For i = 3 To LastRow 
    Range("L" & i).Copy 
    Range("M" & i).Select 
    ActiveSheet.Pictures.Paste.Select 
Next i 

Application.screenupdating = true 

このコードは動作するはずですが、それはVBAで不要である、選択含むが、私は絵のペーストを使用する方法を見当もつかないので、私はテンプレートとしてあなたのコードを使用していました。

Answer 2

ここでは、ループなしですばやく（しかし長い）方法があります。 範囲を設定し、列の最後の行を見つけます。

Excelには同じナッツをスキンケアする方法がたくさんあります。お役に立てれば。

Sub CopyPic() 

    Dim lTopRow As Long 
    Dim lLeftColumn As Long 
    Dim lRightColumn As Long 
    Dim lLastRow As Long 

    With Sheets("Sheet1") 
     lTopRow = .Range("L3").Row 
     lLeftColumn = .Range("L3").Column 

     lLastRow = .Range("L:L").Find("*", , xlValues, , xlByRows, xlPrevious).Row 
     lRightColumn = lLeftColumn 

     Application.Goto .Range(Cells(lTopRow, lLeftColumn), Cells(lLastRow, lRightColumn)), scroll:=False 

     Selection.Copy 

     lLeftColumn = .Range("M3").Column 
     lRightColumn = lLeftColumn 

     Application.Goto .Range(Cells(lTopRow, lLeftColumn), Cells(lLastRow, lRightColumn)), scroll:=False 

     .Pictures.Paste.Select 

    End With 


End Sub