【ﾏｸﾛに関する質問】ｺｰﾄﾞを修正してください｡ twitterで文を書き､Twilogからそれをｴｸｾﾙにｺﾋﾟｰし､ﾜｰﾄﾞへ貼り付けるためにﾏｸﾛを書きました｡この目的は､…

【ﾏｸﾛに関する質問】ｺｰﾄﾞを修正してください｡
twitterで文を書き､Twilogからそれをｴｸｾﾙにｺﾋﾟｰし､ﾜｰﾄﾞへ貼り付けるためにﾏｸﾛを書きました｡この目的は､Ctrl + eで?余分な行を削除し､?行をつめ､?ｺﾋﾟｰをすることです｡ｱｶｳﾝﾄ名とpostedを含む行､空白ｾﾙを含む行を削除し､A行をｺﾋﾟｰしています｡【私の要望】?より簡潔にｺｰﾄﾞを修正してください｡?全ての空白ｾﾙをつめたいのですが､なぜか1行空いてしまいます｡?A列をｺﾋﾟｰした場合､余計な範囲もｺﾋﾟｰしてしまいます｡過不足ない範囲選択とｺﾋﾟｰのしかたを教えてください｡ http://twilog.org/adgt33

Sub ()
' Macro1 Macro
' Keyboard Shortcut: Ctrl+e

ActiveSheet.PasteSpecial Format:="ﾃｷｽﾄ", Link:=False, DisplayAsIcon:= _
Sheets("Sheet1").Select

Do While (True)
Columns("A:A").Select
Set mySelect = Selection.Find(What:="*@adgt33*")
If mySelect Is Nothing Then Exit Do
Rows(mySelect.Row).Select
Selection.Delete Shift:=xlUp
Loop

Do While (True)
Columns("A:A").Select
Set mySelect = Selection.Find(What:="*posted*")
If mySelect Is Nothing Then Exit Do
Rows(mySelect.Row).Select
Selection.Delete Shift:=xlUp
Loop

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("A").Copy

End Sub

Sub ctrl_E()

 ' Macro1 Macro
 ' Keyboard Shortcut: Ctrl+e

'念のため､先にsheets1のA列をｸﾘｱする
 Sheets("Sheet1").Select
 Columns("A:A").ClearContents
 Range("A1").Select

'ｸﾘｯﾌﾟﾎﾞｰﾄﾞのﾃﾞｰﾀをﾃｷｽﾄ形式で貼り付け
 ActiveSheet.PasteSpecial Format:="ﾃｷｽﾄ", Link:=False, DisplayAsIcon:= _
 Sheets("Sheet1").Select

'A列の最後の行を求める
'隣質問の回答 http://q.hatena.ne.jp/1463826490#a1256732 を参考にして
last_row = Cells(Rows.Count, 1).End(xlUp).Row

'後ろの行から消していく
For y = last_row To 1 Step -1  'yに最終行を代入して､step-1で減らしながら処理する
 Delete_Flg = 0  'ﾌﾗｸﾞをｾﾞﾛでｸﾘｱ
 
 chkDATA = Trim("" & Cells(y, "A").Value) 'y行目のA列の値を取得
  '削除したいﾃﾞｰﾀか判断する
 If Len(chkDATA) = 0 Then Delete_Flg = 1  '長さが0なら削除
 If Right(chkDATA, 6) = "adgt33" Then Delete_Flg = 1  '後ろ(右端)がadgt33で終わっていれば
 If Left(chkDATA, 6) = "posted" Then Delete_Flg = 1  '先頭(左端)がpostedなら
 If Left(chkDATA, 6) = "source" Then Delete_Flg = 1  '先頭(左端)がsourceなら
 
  '上記↑判断でﾌﾗｸﾞが立っているか判断
 If Delete_Flg = 1 Then
 Cells(y, "A").Delete Shift:=xlUp  '削除､上方向に詰める
 End If
  '↑上方向に詰めたかったので､後ろ､最終行から上にさかのぼってﾁｪｯｸして
  '削除該当ﾃﾞｰﾀなら消してみた
 
Next

'削除されていると､最終行が変わっているので､
'改めて､最終行を求める
'隣質問の回答 http://q.hatena.ne.jp/1463826490#a1256732 を参考にして
last_row = Cells(Rows.Count, 1).End(xlUp).Row

'A1先頭からA最終行までを選択ｺﾋﾟｰ
Range("A1:A" & last_row).Copy

End Sub

他の質問
http://q.hatena.ne.jp/1463826490#a1256732
を参考にすると､最終行が取得できるので､
後ろからforで回して､
下から上にﾁｪｯｸしていくｲﾒｰｼﾞで､
不必要なﾃﾞｰﾀをleftやrightで判断して
(instrで探してもよかったかもしれませんが)
削除してみました｡

もっと簡潔に書けそうな気もしますが､
叩き台の回答として､使ってみてください｡
※他の回答者から袋叩きにされないか気にしつつ･･･