|
▼UO3 さん:
ありがとうございます。
行移動させると、移動した分だけ表が小さくなる(関数の入っているセルもある為)ので最終行2000行目をコピーしてそれを2000行目にコピーしたいです。
素人ながら、下記を入れてみました。
Rows("2000:2000").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveWindow.ScrollRow = 10
1行移動だとこれでOKですが、複数移動した場合も1行追加になってしまいます。
移動した行数分追加したいです。下記のどこに追加すればいいかもご教授ください。
>
>Sub ふたつ目()
> Const fLine As Long = 10 ' データ開始行
> Const tLine As Long = 10 ' データ開始行
>
> Dim shTo As Worksheet
> Dim Wb As Workbook
> Dim c As Range
> Dim z As Long
> Dim r As Range
>
> Application.ScreenUpdating = False
>
> Set Wb = Workbooks.Open(ThisWorkbook.Path & "\Shipped.xls")
> Set shTo = Wb.Worksheets("Shipped")
>
> With ThisWorkbook.Sheets("Schedule")
> For Each c In .Range("A" & fLine, .Range("A" & .Rows.Count).End(xlUp))
> If c.Value = 1 Then
> z = shTo.Range("A" & shTo.Rows.Count).End(xlUp).Row + 1
> shTo.Range("A" & z & ":AU" & z).Value = c.EntireRow.Range("A1:AU1").Value
> If r Is Nothing Then
> Set r = c
> Else
> Set r = Union(r, c)
> End If
> End If
> Next
> If Not r Is Nothing Then r.EntireRow.Delete
> Application.Goto shTo.Range("A1")
> End With
>
> Application.ScreenUpdating = True
> MsgBox "転記完了"
>End Sub
|
|