| |
下記コードこのサイトで『ぴかるさん』に教えていただいたものです☆Ａ列の同じデータごとに行ごとコピーして新規ブックを開いて貼付け・・なんですが、Sheet1ではうまくいきますが、これをSheet2で実行すると
↓
sh.Range(行).Copy Destination:=ActiveSheet.Range("A2")
のところでエラーを起こしてしまいます。（Rangeメソッドは失敗しました。"Worksheet"オブジェクト とエラーメッセージが表示されます。）
ぴかる様、ご覧になっていたらよろしくお願いいたします。
どなたかわかる方、いらっしゃいましたら教えてくださいm(_ _)m
宜しくお願い致します。
Sub 図番ごと新規ブックに保存()
Dim カウント As Integer
Dim 文字 As String
Dim 行 As String
Dim i As Long
Dim sh As Worksheet
Dim j As Long
Set sh = ActiveWorkbook.ActiveSheet 'ThisWorkbook.ActiveSheet
カウント = 0
文字 = Range("A2").Text
j = 1
For i = 2 To Range("A1").End(xlDown).Row + 1
If sh.Range("A" & i).Text = 文字 Then
If カウント = 0 Then
行 = i & ":" & i
カウント = 1
Else
行 = 行 & "," & i & ":" & i
End If
Else
Application.ScreenUpdating = False
Workbooks.Add
sh.Range(行).Copy Destination:=ActiveSheet.Range("A2")
【Sheet1】
A B C D E F
1 親図番 部番 部品ｺｰﾄﾞ 部品名 新部品コード 新部品名
2 123 16 D0-00087000 C D0-16101000 C
3 456 16 D0-00087000 A D0-16101000 C
4 456 12 D0-00063000 B D0-15936000 D
5 789 12 D0-00063000 B D0-15936000 D
6 012 12 D0-00063000 B D0-15936000 D
【Sheet2】
A B C D E F
1 親図番 部番 部品ｺｰﾄﾞ 部品名 新部品コード 新部品名
2 123 9 C0-02046000 C
3 456 12 C0-00169000 A
4 456 16 D0-00087000 B D0-16101000 D
5 789 17 D0-05976000 B
6 012 19 E0-00615000 B
|
|
- 04/3/24(水) 18:08 -
