Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43807 / 76732 ←次へ | 前へ→

【37952】セルの値を違うブックのシートに上から順に貼り付ける
質問  だいすけ  - 06/5/24(水) 9:38 -

引用なし
パスワード
   まずこれを見てください

Sub 目録貼り付け()
'コピーしたものを貼り付けるファイルを開く
Dim Fname As String
 Fname = Application.GetOpenFilename(filefilter:="Excelファイル,*.xls,すべてのファイル,*.*")
  If Fname = "false" Then
 Exit Sub
End If
Workbooks.Open Filename:=Fname
'コピー元があるファイルを開く
 Fname2 = Application.GetOpenFilename(filefilter:="Excelファイル,*.xls,すべてのファイル,*.*")
  If Fname2 = "false" Then
   Exit Sub
  End If
Workbooks.Open Filename:=Fname2

'コピー元のファイルのシート名に「目録」が含まれるシートを選択
Dim ws As Worksheet
 For Each ws In Worksheets
  If InStr(ws.Name, "目録") <> 0 Then
   ws.Activate
  ActiveSheet.Range("A1").Activate
 
'コピー元の選択したシートのAセルの値を上から順に読み取る(条件つけて)
Dim R As Range
Dim MyR As Range
Set MyR = Range("A1", Range("A65536").End(xlUp))
For Each R In MyR
'If1 結合あり
If Selection.MergeCells Then
   '○ひとつしたのセルへ
    Selection.Offset(1, 0).Select
    Selection.Offset(0, 2).Select
'ElseIf1 結合なし
ElseIf Not Selection.MergeCells Then
  'If2 空セル
   If Selection.Value = "" Then
   '○ひとつしたのセルへ
   Selection.Offset(1, 0).Select
  'ElseIf2 空セルでない
   ElseIf Selection.Value <> "" Then
     'If22 セルの文字数が4文字以下
     If 4 >= Len(Selection.Value) Then
     '○ひとつしたのセルへ
     Selection.Offset(1, 0).Select
     'If22 セルの文字数が4文字よりうえ
     ElseIf 4 < Len(Selection.Value) Then

 '条件にあったセルの値を最初に開いていたファイルのシート1のAセルに上から順に貼り付ける
     Dim j As Long
     j = 1: On Error GoTo ELine
     Selection.Copy Workbooks("test.xls").Worksheets("Sheet1") _
     .Cells(j, 1)
     j = j + 1
 
ELine:
      If Err.Number <> 0 Then MsgBox Err.Description


   'End22 If
    End If
   'End2 If
   End If
  'End1 If
   End If

  Next R
 End If
Next ws
ActiveWorkbook.Close
End Sub

現在このような感じで作成しているのですが、
コピーしたものを、別に開いてあるブックに
上から順に貼り付けることが出来ません。

違うところは多々あるとは思いますが、
出来れば、ヒントなりをお教えねがいませんでしょうか?
0 hits

【37952】セルの値を違うブックのシートに上から順に貼り付ける だいすけ 06/5/24(水) 9:38 質問
【37953】Re:セルの値を違うブックのシートに上か... ハチ 06/5/24(水) 10:01 発言
【37961】Re:セルの値を違うブックのシートに上か... だいすけ 06/5/24(水) 11:55 発言
【37972】Re:セルの値を違うブックのシートに上か... ハチ 06/5/24(水) 13:26 回答
【37987】Re:セルの値を違うブックのシートに上か... だいすけ 06/5/24(水) 17:05 お礼

43807 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free