需要将数据从一个工作表复制粘贴到两个工作表中都匹配的第二个基础列标题,并跳过要粘贴数据的第二个工作表中的一行。
我能够通过匹配列标题来成功传输数据,但是无法执行跳过第二个工作表上的一行的操作。
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
当前数据已粘贴到整个范围,但无法跳过第二个工作表中的空白行。