hi,
i have 2 WB's
WB1 --> sheets 1(update1)-->columns(first name, middle name, last name, address, address1...)
WB2 -->8sheets(with specific names) -->columns(varies but might have same column name as in WB1 or might not have)
issue: need to copy a column from WB1 say first name, paste it in all relavent sheets with column name "first name"
again search for last name and paste in WB2 on relavent sheets and in relavent column name,
i have coded a bit here but it does in same workbook but not in different work book. please have a look
Option Explicit
'Function to check if worksheets entered in input boxes exist
Public Function wsExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
wsExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0 ' now it will error on further errors
End Function
Sub copy_using_header()
Dim i As Integer
Dim a(1 To 1) As Integer
Dim b(1 To 1) As Integer
Dim lkup As String
Dim dummy As Variant
Dim Sheet_Copy_From As String
Dim Sheet_Copy_To As String
Dim sn As Variant 'sheet name from array to test
Dim an As Variant 'Array
Dim lkr As range
Dim ahd As Variant
Dim chd As Variant
Dim cn As Long
Dim ws As Worksheet
Dim lkr1 As range
Dim ahd1 As Variant
Dim chd1 As Variant
Dim cn1 As Long
Dim ws1 As Worksheet
Application.ScreenUpdating = False
Sheet_Copy_From = Application.InputBox(Prompt:= _
"Please enter the sheet name you which to copy from", _
Title:="Sheet_Copy_From", Type:=2) 'Type:=2 = text
If Sheet_Copy_From = "False" Then
Exit Sub
End If
Sheet_Copy_To = Application.InputBox(Prompt:= _
"Please enter the sheet name you which to paste in", _
Title:="Sheet_Copy_To", Type:=2) 'Type:=2 = text
If Sheet_Copy_To = "False" Then
Exit Sub
End If
an = Array(Sheet_Copy_From, Sheet_Copy_To)
For Each sn In an
Select Case wsExists(sn)
Case False
MsgBox "The worksheet named ....""" & sn & """ .... is either missing" & vbNewLine & _
"or spelt incorrectly" & vbNewLine & vbNewLine & _
"Please rectify and then run this procedure again" & vbNewLine & vbNewLine & _
"Select OK to exit", _
vbInformation, ""
Exit Sub
End Select
Next
For i = 1 To 1
Select Case i
Case 1
lkup = Application.InputBox(Prompt:= _
"Please enter column heading name", _
Title:="InputBox Method", Type:=2)
End Select
If lkup = "False" Then
Exit Sub
End If
On Error Resume Next
a(i) = Sheets(Sheet_Copy_From).Rows(1).Find(lkup, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
b(i) = Sheets(Sheet_Copy_To).Rows(1).Find(lkup, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
Sheets(Sheet_Copy_From).Select
range(Cells(2, a(i)), Cells(Cells(Rows.Count, a(i)).End(xlUp).Row, a(i))).Copy ' Only copies from row 2
Sheets(Sheet_Copy_To).Activate
With Cells(2, b(i)) ' Pastes from row 2 down
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Next
On Error GoTo 0
Set dummy = Worksheets(1).Cells.Find(What:=" ", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
Application.ScreenUpdating = True
End Sub
Bookmarks