| |
取り敢えず、マクロの記録で出来たコードを編集します。
>Selection.Copy
>Sheets("Sheet2").Select
>Range("A1").Select
>ActiveSheet.Paste
>Application.CutCopyMode = False
>Selection.Copy
>Workbooks.Add
>ActiveSheet.Paste
>Application.CutCopyMode = False
>ActiveWorkbook.SaveAs Filename:= _
> "C:\Documents and Settings\g0238\My Documents\Book2.xls", FileFormat:= _
> xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
> , CreateBackup:=False
>
>ActiveWindow.Close
↓
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\g0238\My Documents\Book2.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
次に、コピーする領域は Selection ではありませんので、この部分を直します。
簡単のために、ワークシートオブジェクトを変数に格納します。
変数の宣言とデータの設定処理を追加します。
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
これらを使って
>Selection.Copy
>Workbooks.Add
>ActiveSheet.Paste
>Application.CutCopyMode = False
↓
Workbooks.Add
sh.Range(行).Copy Destination:=ActiveSheet.Cells(1, 1)
これをぴかる さんのコードとあわせて、
Sub Test()
Dim カウント As Integer
Dim 文字 As String
Dim 行 As String
Dim i As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.ActiveSheet
カウント = 0
文字 = InputBox("データを入力して下さい。")
For i = 1 To Range("A2").End(xlDown).Row
If Range("A" & i).Text = 文字 Then
If カウント = 0 Then
行 = i & ":" & i
カウント = 1
Else
行 = 行 & "," & i & ":" & i
End If
End If
Next
If カウント = 1 Then
' Range(行).Select
Workbooks.Add
sh.Range(行).Copy Destination:=ActiveSheet.Cells(1, 1)
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\g0238\My Documents\Book2.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
Else
MsgBox "該当行無しです。"
End If
End Sub
|
|
