2017-03-20 7 views
0

は、私が列12、柱3のみの& 4と式の値を貼り付けしようとしています。エクセル複数のペーストスペシャル

私はどちらか得ることができますまたはすべての4列を操作することが、私はこれが私の唯一の柱4上の値を示します.PasteSpecial xlPasteFormulasAndNumberFormats

Sub FindData() 'Find Both 
Application.ScreenUpdating = False 
Dim datasheet As Worksheet 'data copied from 
Dim reportsheet As Worksheet 'data pasted to 
Dim partone As String  'search criteria 1 
Dim parttwo As String  'search criteria 2 
Dim finalrow As Integer  'find last used row 
Dim i As Integer    'row counter 

'set variables 
Set datasheet = Sheet2 
Set reportsheet = Sheet4 
partone = reportsheet.Range("E6").Value 
parttwo = reportsheet.Range("F6").Value 

'clear old data from reort sheet 
reportsheet.Range("A10:D110").ClearContents 

'goto datasheet and start searching and copying 
datasheet.Select 
finalrow = Cells(Rows.Count, 1).End(xlUp).Row 

'loop through the rows to find matching records 
For i = 10 To finalrow 
If Cells(i, 5) = partone And Cells(i, 6) = parttwo Then 
    Range(Cells(i, 1), Cells(i, 4)).Copy 
    reportsheet.Select 
    Range("A101").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
    datasheet.Select 
    End If 
Next i 

reportsheet.Select 
Range("E9:F9").Select 
Application.ScreenUpdating = True 

End Sub 
+2

私は3を=かどうかを確認する場合は、あなたの現在までのIf句を追加しますか? – SJR

+0

あなたの質問には答えられませんが、 'someSheet.Select'を使用し続ける必要はありません。ワークシート変数を直接使用する方が安全で迅速です。例えば。 'finalrow = datasheet.Cells(Rows.Count、1).End(xlUp).Row'です。同じワークシートを参照したくない場合は、With文を使用してください。 – SteveES

+0

@SteveESあなたがアドバイスをしているならば、あなたの 'finalrow'は完全修飾ではなく、' finalrow = datasheet.Cells(datasheet.Rows.Count、1).End(xlUp).Row'である必要があります。 –

答えて

0

でのみ1列操作を行う方法がわからないです。私が尋ねたことの反対ですが、同じ結果をもたらします。

For i = 10 To finalrow 
If Cells(i, 5) = partone And Cells(i, 6) = parttwo Then 
    Range(Cells(i, 1), Cells(i, 3)).Copy 
    reportsheet.Select 
    Range("A101").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
    datasheet.Select 
    End If 
If Cells(i, 5) = partone And Cells(i, 6) = parttwo Then 
    Range(Cells(i, 4), Cells(i, 4)).Copy 
    reportsheet.Select 
    Range("A101").End(xlUp).Offset(0, 3).PasteSpecial xlPasteValues 
    datasheet.Select 
    End If 
Next i 
+0

このコードは私のコメントを参考にしていますか? – SJR

0

以下のコードには、列Aから値をコピーします:BとD、およびreportsheetにそれらを貼り付け、コラムC.

からのみの数式をコピーします:あなたはあまりにも持っています多くのSelectおよび非修飾オブジェクトの場合、以下のコードのオブジェクトはWithステートメントを使用してワークシートで完全修飾されています。

コード

Option Explicit 

Sub FindData() 'Find Both 

Dim datasheet As Worksheet 'data copied from 
Dim reportsheet As Worksheet 'data pasted to 
Dim partone As String  'search criteria 1 
Dim parttwo As String  'search criteria 2 
Dim finalrow As Long  'find last used row 
Dim i As Long    'row counter 

Application.ScreenUpdating = False 

'set variables 
Set datasheet = Sheet2 
Set reportsheet = Sheet4 

With reportsheet 
    partone = .Range("E6").Value 
    parttwo = .Range("F6").Value 

    'clear old data from reort sheet 
    .Range("A10:D110").ClearContents 
End With 

' start searching and copying from datasheet 
With datasheet 
    finalrow = .Cells(.Rows.Count, 1).End(xlUp).Row 

    'loop through the rows to find matching records 
    For i = 10 To finalrow 
     If .Range("E" & i).Value = partone And .Range("F" & i).Value = parttwo Then 

      Dim firstEmptyCell As Range 
      Set firstEmptyCell = reportsheet.Range("A1000").End(xlUp).Offset(1) 

      firstEmptyCell.Resize(1, 2).Value = .Range("A" & i & ":B" & i).Value 
      firstEmptyCell.Offset(, 3).Value = .Range("D" & i).Value 
      .Range("C" & i).Copy 
      firstEmptyCell.Offset(, 2).PasteSpecial xlPasteFormulas 
     End If 
    Next i 
End With 

'reportsheet.Select ' <-- not sure why you need it 
'Range("E9:F9").Select ' <-- not sure why you need it 
Application.ScreenUpdating = True 

End Sub 
+0

@Matt Taylor上記のコードを試してみましたか?どんなフィードバック? –

関連する問題