excel多个粘贴特价

我在尝试粘贴列的值1,2,& 4和仅列3的公式。excel多个粘贴特价

我可以任一或所有的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

来源

2017-03-20 Matt Taylor

添加如果条款对你目前如果要检查是否I = 3？ – SJR

不是你的问题的答案，但你不需要继续使用'someSheet.Select'，直接使用工作表变量更安全，更快捷。例如。 'finalrow = datasheet.Cells（Rows.Count，1）.End（xlUp）.Row'。如果您不想继续引用同一个工作表，请使用'With'语句块。 – SteveES

@SteveES如果你给出建议，给它正确的，你的'finalrow'不是完全合格的，它需要是'finalrow = datasheet.Cells（datasheet.Rows.Count，1）.End（xlUp）.Row' –

这给了我值仅在4列只做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

来源

2017-03-20 16:45:43

这段代码是否参考了我的评论？ – SJR

下面的代码将只从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

来源

2017-03-20 18:02:00

@Matt Taylor你有没有试过我的代码？任何反馈？ –

excel多个粘贴特价

回答

相关问题