VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [管理用]

投稿日: 2004/09/09(Thu) 18:45
投稿者ももたろう
Eメール
URL
タイトル複数のExcelファイルの値コピー

複数のExcelファイルの中から、A列が空白の行のものを全て"新規抽出一覧.xls"にコピーし、
A列が空白行の一覧表を作りたいのですが下記コード中の***の箇所が分かりません。
単純にcopy、pasteではできないし、クリップボードを使った方がいいのかなど最適な方法と
書き方又は、参考URLなど、教えて下さい。
(クリップボードはまだ使ったことがなく、よくわからないので自分でも調べてみますが。)
よろしくお願いします。

    '新規抽出一覧.xlsを開く
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = xlApp.Workbooks.Open(sSeishikiPath & "\" & "新規抽出一覧.xls")
        Set xlSheet = xlBook.Worksheets(1)
        
        '一番最後にsheet追加
        xlApp.Worksheets.Add After:=Sheets(Sheets.Count)    '一番最後にsheet追加
        sSheetname = Replace(Date, "/", "") & Replace(Time, ":", "")    '追加するsheet名
        iSheet = Sheets.Count   'sheet数
        Sheets(iSheet).Name = sSheetname    '追加したsheet名変更
        
        For i = 0 To iCount3 - 1
            Set xlApp = CreateObject("Excel.Application")
            Set xlBook = xlApp.Workbooks.Open(sExcelPath & "\" & sTargetFile2(i).file)
            Set xlSheet = xlBook.Worksheets(1)
              
            '何行データがあるか?
            xlSheet.Range("B1").End(xlDown).Select    '最終行までスクロール
            row = xlApp.ActiveCell.row    'データのある最終行

            '新規があるか?
            For a = 3 To (row - 1)
                If xlSheet.Range("A" & a).Value = "" Then   'A列に空白セルがあるか?
          '*******************
          'ここでA列に空白セルがあったらその行を前の処理で作った
          '新規抽出一覧.xlsのsSheetnameシートにコピーしたいです
          '*******************
                Else
                    xlSheet.Range("A" & a).End(xlDown).Select   '空白行分スクロール
                    y = xlApp.ActiveCell.row   '空白行の最終行
                    'スクロールしたセルの1行前のセルが空白でないなら処理行を飛ばす
                    If xlSheet.Range("A" & y - 1).Value <> "" Then
                        a = y
                    End If
                End If
            Next
        Next


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- VBレスキュー(花ちゃん) - - Web Forum -