Excelのマクロを生まれて初めて触っています。

業務上、必要に迫られて、すぐに何とかしなければいけないのですがうまくいきません。

Sub シート結合()
Dim S1 As Worksheet
Dim i As Integer
Dim j As Integer
Dim r As Range

Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Set S1 = ActiveSheet

j = 1
For i = 1 To Sheets.Count
For Each r In Range("A1", Range("A65536").End(xlUp))
If r.Value = "" Then Exit For
r.EntireRow.Copy S1.Cells(j, 1).EntireRow
j = j + 1
Next r
Next i
End Sub

マクロを実行したら、新規にシートを作成し、他のシートに書いてある全てのセルの中身をコピーしたい

マクロを実行しても、新規シートは作成されるが何もコピーされてこない、という状況です。
誰か直して下さい。

そもそも考え方が違うよ、こんな書き方しなくても全然違う書き方でスマートにやれるよ、というのも大歓迎です。
VBAに初めて触れてまだ3時間ほどなので、そこらへんは全然分かっていないので。
基礎からやれよ、という回答はご遠慮下さい。重々承知の上で、しかし時間がないのでやむなくなのです。

回答の条件
  • 1人2回まで
  • 登録:2007/05/09 17:55:47
  • 終了:2007/05/09 18:53:24

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692007/05/09 18:32:22

ポイント50pt

こんな感じでできます。

Sub シート結合()
    Dim S1 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim r As Range
    
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    Set S1 = ActiveSheet

    j = 1
    For i = 1 To Worksheets.Count - 1
        Worksheets(i).UsedRange.Copy Destination:=S1.Range("A" & j)
        j = j + Worksheets(i).UsedRange.Rows.Count
    Next i
End Sub
id:nacbox

ありがとうございます!

こちらはまた、最適化していただいて、短い時間の勉強では一度も見たことのない書き方とかがあって、やはり泥縄では駄目ですね。

実行速度も速くて助かりました。

とりあえず動いたらすぐに客先に見せなければいけないので、後回しにはなりますがのちほどじっくりリファレンス片手に勉強させていただきます。

回答いただいたお二人ともいるかにしたいところなんですが、いるかは一人しか付けられないので、悩みましたが、実際に使用させていただいたSALINGERさんにいるかします。

ありがとうございました!

2007/05/09 18:52:34

その他の回答(1件)

id:ota2244 No.1

ota2244回答回数77ベストアンサー獲得回数42007/05/09 18:26:06

ポイント50pt

記載のソースからなるべく近い形で作ってみました。


Sub シート結合()

 Dim lRow As Long

 Dim lCol As Long

 Dim lIdx As Long

 Dim oSheet As Worksheet

 Dim oSheetNew As Worksheet

 Dim oCell As Range


 Worksheets.Add.Move after:=Worksheets(Worksheets.Count)

 Set oSheetNew = ActiveSheet


 lRow = 0

 For lIdx = 1 To Worksheets.Count - 1

  Set oSheet = Worksheets(lIdx)

  For Each oCell In oSheet.Range("A1", "A65536")

   'データの存在しない行を見つけた場合は次のシートへ

   If oCell.Text = "" Then Exit For

   lRow = lRow + 1

   oSheet.Rows(oCell.Row).Copy

   oSheetNew.Rows(lRow).PasteSpecial

  Next

 Next

End Sub

id:nacbox

おおお、ありがとうございます。

見事に実行されました。

私の作ったソースに沿って書いて頂いたお陰で、自分のソースの何がいけないのか、勉強になって助かります。

ありがとうございました!

2007/05/09 18:49:20
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692007/05/09 18:32:22ここでベストアンサー

ポイント50pt

こんな感じでできます。

Sub シート結合()
    Dim S1 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim r As Range
    
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    Set S1 = ActiveSheet

    j = 1
    For i = 1 To Worksheets.Count - 1
        Worksheets(i).UsedRange.Copy Destination:=S1.Range("A" & j)
        j = j + Worksheets(i).UsedRange.Rows.Count
    Next i
End Sub
id:nacbox

ありがとうございます!

こちらはまた、最適化していただいて、短い時間の勉強では一度も見たことのない書き方とかがあって、やはり泥縄では駄目ですね。

実行速度も速くて助かりました。

とりあえず動いたらすぐに客先に見せなければいけないので、後回しにはなりますがのちほどじっくりリファレンス片手に勉強させていただきます。

回答いただいたお二人ともいるかにしたいところなんですが、いるかは一人しか付けられないので、悩みましたが、実際に使用させていただいたSALINGERさんにいるかします。

ありがとうございました!

2007/05/09 18:52:34

この質問への反応(ブックマークコメント)

トラックバック

  •  10/16 今日の調べ物 売上げデータを取り込んで、請求明細表を作成するマクロをつくっていたので、 主にエクセルVBAがらみの検索が多い。 また新たな壁にぶち当たったが、今後のテーマ
「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません