我们如何通过跳过下一张纸中的行将数据从一张纸传输到另一张纸?

时间:2019-07-03 09:32:18

标签: excel vba

需要将数据从一个工作表复制粘贴到两个工作表中都匹配的第二个基础列标题,并跳过要粘贴数据的第二个工作表中的一行。

我能够通过匹配列标题来成功传输数据,但是无法执行跳过第二个工作表上的一行的操作。


Option explicit

Public ws1 As Worksheet
Public ws2 As Worksheet
Public b As Long
Public c As Long
Public i As Long

Sub pMain()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

  Dim j As Long
  Dim k As Long
  Dim m As Long
  Dim lMatch As Long

ThisWorkbook.Activate

Set ws1 = Sheets("Completed or resolved") '*** Worksheet- Completed or resolved-****
    Set ws2 = Worksheets("Enter Detailed Updates Here")

  m = 1
  j = ws1.Cells.Find("*", ws1.Cells(1), xlValues, xlPart, xlByRows, xlPrevious).Row ' finding last row of worksheet-Completed or Resolved
  k = ws1.Cells.Find("*", ws1.Cells(1), xlValues, xlPart, xlByColumns, xlPrevious).Column ' finding last columns of worksheet-Completed or Resolved

  For i = 1 To k

    lMatch = pMatch(ws2.Cells(1, i), ws1.Rows(1))

    If lMatch <> 0 Then
        ws1.Activate
        'ws1.Cells(i, lMatch).Copy
            ws1.Range(Cells(2, lMatch), Cells(j, lMatch)).Copy
                ws2.Activate
                Call fnRMatch
            'ws2.Cells(2, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ws2.Cells(2, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ElseIf lMatch = 0 Then
    End If

  Next i

  Application.CutCopyMode = False

  MsgBox "Database Saved", vbOKCancel

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

End Sub
Private Function pMatch(vValue As Variant, _
                        vArray As Variant) As Long
  Dim ret As Long

  On Error Resume Next
  ret = WorksheetFunction.Match(CDbl(vValue), vArray, 0)
  If ret = 0 Then ret = WorksheetFunction.Match(CStr(vValue), vArray, 0)

  pMatch = ret
End Function

Function fnRMatch()
'finding last row of worksheet - Enter detailed updates here
        b = ws2.Cells.Find("*", ws2.Cells(1), xlValues, xlPart, xlByRows, xlPrevious).Row
End Function

Function fnCMatch()
'finding last column of worksheet - Enter detailed updates here
        c = ws2.Cells.Find("*", ws2.Cells(1), xlValues, xlPart, xlByColumns, xlPrevious).Column

End Function

当前数据已粘贴到整个范围,但无法跳过第二个工作表中的空白行。

0 个答案:

没有答案