[[20100923171850]]　『別シートに自動転記』（ぎん）　ページの最後に飛ぶ

『別シートに自動転記』（ぎん）

 下記のように一覧表シートに追記すると各シート（名古屋・東京・静岡）				
 の一番下に自動転記するようにしたいのですがよろしくおねがいします				
 マクロがほんのすこしだけできるようになったとういうレベルです		 		
 よろしくおねがいします				
 XP　2003

	seet1・・・一覧表			
 	A	B	
1	名古屋	あ	
2	静岡	あ	
3	名古屋	い	
4	東京	あ	
5	東京	い	
6	静岡	い	
7	東京	う	・・・seet2　A3に追記
8	名古屋	う	・・・seet3　A3に追記
9	静岡	う	・・・seet4　A3に追記

	seet2・・・名古屋		
1	東京	あ	・・・seet1　A4がすでに転記済み
2	東京	い	・・・seet1　A5がすでに転記済み
3	東京	う	・・・seet1　A7が自動追記される

	seet3・・・東京		
1	名古屋	あ	・・・seet1　A1がすでに転記済み
2	名古屋	い	・・・seet1　A3がすでに転記済み
3	名古屋	う	・・・seet1　A8が自動追記される

	seet3・・・静岡		
1	静岡	あ	・・・seet1　A2がすでに転記済み
2	静岡	い	・・・seet1　A6がすでに転記済み
3	静岡	う	・・・seet1　A9が自動追記される

 こんばんは
 なんかシート名がおかしいですね。
 [[20100827094339]]に書いたのですが、Sheet2～4を開くたびに抽出し直した方が簡単だと思います。
 データ量が多すぎるとレスポンスの問題は有るかも知れませんけど。
（ウッシ）

（ウッシ）さま

 おはようございます
 すみません。シート名おかしいですね　seet3が二つありました　seet4の間違いです

 [[20100827094339]]の方と同じことでした。参考にしてやってみます。
 うまく動かせたらご報告します
 ありがとうございました。

（ぎん）

（ウッシ）さま

 お世話になります

  [[20100827094339]]のデータは動作確認できました、「すごい」の一言です

 実際のデータでやってみましたら見出しだけが各シートに転記されました
 実際データは2000行あり振り分けたい列はH列で見出し名は「支店」です
 コードのどこを変更したいいのかわからないので教えてください。

 実際のシート名に変更しました

 標準モジュールに

Sub Filter_1(Sh As Worksheet)

    Dim Sh1 As Worksheet
    Dim c   As Range
    Dim t   As Range
    Dim m   As Range
    Dim i   As Long

    Application.ScreenUpdating = False

    Set Sh1 = Worksheets("15-22明細")
    Set m = Sh1.Range("A1").CurrentRegion
    i = m.Columns.Count

    With Sh
        .UsedRange.ClearContents

        m.Rows(1).Copy .Range("A1")
        Set t = .Range("A1").CurrentRegion

        .Range("A1").Cells(1, i).Copy .Cells(1, i + 2)

        Select Case Sh.Name
            Case "静岡":     .Cells(2, i + 2) = "静岡"
            Case "名古屋":     .Cells(2, i + 2) = "名古屋"
            Case "東京":     .Cells(2, i + 2) = "東京"
            Case "東北":     .Cells(2, i + 2) = "東北"
        End Select

        Set c = .Cells(1, i + 2).CurrentRegion

        m.AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=c, _
            CopyToRange:=t, Unique:=False

        c.ClearContents

    End With

    Application.ScreenUpdating = False
End Sub

「ThisWorkbook」に

rivate Sub Workbook_SheetActivate(ByVal Sh As Object)

    Select Case Sh.Name
        Case "静岡", "名古屋", "東京", "東北":   Call Filter_1(Sh)
        Case Else:                           Exit Sub
    End Select
End Sub

よろしくおねがいします

（ぎん）

 こんにちは
 > 振り分けたい列はH列
でしたら、
         .Range("A1").Cells(1, i).Copy .Cells(1, i + 2)
を
         .Range("A1").Cells(1, "H").Copy .Cells(1, i + 2)
に変更して下さい。
（ウッシ）

（ウッシ）様

 できました　すばらしいです！感謝の気持ちでいっぱいです
 いつの日かコードが読めるようになりたいです。
 私には夢のようなはなしですが･･･。
 本当にありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20100923171850]] 『別シートに自動転記』（ぎん） ページの最後に飛ぶ

[[20100923171850]]　『別シートに自動転記』（ぎん）　ページの最後に飛ぶ