多くのシートのデータを別のものにコピーしようとしています。toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues
は「ランタイムエラー1004」で失敗し続けます。コピーペーストのサイズは同じではありません...セルを1つだけ選択してください... "xlDownとCopy PasteSpecialを使用して多数のデータシートをコピー/ペーストする
これを修正する方法はわかりません。これの全ポイントは何も選択しないことです!私は選択肢の使用を避けようとしています。この行で
Option Explicit
Sub CopyFastenerMargins()
Dim StartTime As Double 'track code run time
Dim secondsElapsed As Double
StartTime = Timer
Application.ScreenUpdating = False 'turn off blinking
Dim nameRange As Range, r As Range, sht As Range
Dim fromSheet As Worksheet, toSheet As Worksheet, sheetName As String
Dim fromRow As Long, fromCol As Long, LCID As Variant
Dim toRow As Long, toCol As Long, rowCount As Long
Dim FSY As Range, FSYvalue As Double
Dim FSU As Range, FSUvalue As Double
Dim analysisType As String, analysisFlag As Integer
'Set range containing worksheet names to loop thru
Set nameRange = Worksheets("TOC").Range("A44:A82")
'Set destination worksheet
Set toSheet = Sheets("SuperMargins")
'find data and copy to destination sheet
'Loop thru sheets
Dim i As Long
For i = 1 To 3
'pickup current sheet name
sheetName = nameRange(i)
Set fromSheet = Sheets(sheetName)
'find starting location (by header) of data and set range
Set r = fromSheet.Cells.Find(What:="Minimums by LCID", After:=fromSheet.Cells(1, 1), Lookat:=xlWhole, MatchCase:=True)
Set r = r.Offset(2, -1)
fromRow = r.Row
fromCol = r.Column
'set row column indices on destination sheet
toCol = 2
toRow = lastRow(toSheet) + 1 'get last row using function
'Copy LCID Range
fromSheet.Activate
fromSheet.Range(Cells(fromRow, fromCol), Cells(fromRow, fromCol).End(xlDown)).Copy
toSheet.Activate
**'********************************NEXT LINE THROWS ERROR**
toSheet.Range(Cells(toRow, toCol), Cells(toRow, toCol)).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
secondsElapsed = Round(Timer - StartTime, 2)
MsgBox ("Done. Time: " & secondsElapsed)
End Sub
' function to determine last row of data
Function lastRow(sht As Worksheet) As Long
' source: http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba
With sht
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastRow = 1
End If
End With
End Function
xlDownは常に**ワークシートの一番下まで移動しませんが、元のセルが値を持つその列の最後のセルである場合に発生します。 [ctrl] + [下向き矢印]をタップするのと同じです。 – Jeeped
元のセルは最後のセルではなく、その下に空白がありません。 xlUpを使用することはできません。なぜなら、ヘッダーを含めるからです。 – Saladsamurai
'.Cells(fromRow、fromCol)'が列の2番目のセルである場合、そこから '.Cells(.rows.count、fromCol).End(xlUp)'まですべてを取得してもOKです。ヘッダーが列全体の** only **値でない限り、ヘッダーを取得することはありません。 – Jeeped