Excel VBA質問箱 IV

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

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


43788 / 76732 ←次へ | 前へ→

【37972】Re:セルの値を違うブックのシートに上か...
回答  ハチ  - 06/5/24(水) 13:26 -

引用なし
パスワード
   ▼だいすけ さん:

>>2、なにをコピーしたいのでしょうか? 空白以外 and 4文字以上?
>コピーしたい内容は、Aセルにある値のうち空白以外で、4文字以上の物
>のみです。

よく考えたら空白のセルは4文字以下ですね^^


Sub 目録貼り付け()

Dim Fname As String
Dim wb, Addwb As Workbook
Dim ws As Worksheet
Dim R As Range
Dim wb_r As Long

'コピーしたものを貼り付けるファイルを開く
Fname = Application.GetOpenFilename(filefilter:="Excelファイル,*.xls,すべてのファイル,*.*")
  If Fname = "False" Then Exit Sub
Set wb = Workbooks.Open(Fname)

'コピー元があるファイルを開く
Fname = Application.GetOpenFilename(filefilter:="Excelファイル,*.xls,すべてのファイル,*.*")
  If Fname = "False" Then Set wb = Nothing: Exit Sub
Set Addwb = Workbooks.Open(Fname)

wb_r = wb.Worksheets(1).Range("A1").Range("A65536").End(xlUp).Row
If wb_r <> 1 Then wb_r = wb_r + 1

'コピー元のファイルのシート名に「目録」が含まれるシートを選択
For Each ws In Addwb.Worksheets
  If InStr(1, ws.Name, "目録") <> 0 Then
    For Each R In Range(ws.Range("A1"), ws.Range("A1").Range("A65536").End(xlUp))
      If R.MergeCells = False And Len(R.Value) >= 4 Then
        wb.Worksheets(1).Cells(wb_r, 1).Value = R.Value
        wb_r = wb_r + 1
      End If
    Next R
  End If
Next ws

'コピー元のファイルを閉じる?
Addwb.Close
Set wb = Nothing
Set Addwb = Nothing

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 お礼

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