Hello, I am looking for some easiest way how to do the following: 1) Find Column1 Header on sheet1, 2) Select all data from that column (Without Header to last used cell), 3) Copy this selection, 4) Find Column2 Header on sheet2, 5) Paste data below it
I have put together code that can do it but it seems very long to me and I now there is definitely a better way how to do that , so I will be thankful for any advice how to make it simpler, because then I can use it for more columns without having 1km of code
Option Explicit
Private Sub Search_Copy()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Range
Dim FindString As String
Dim Rng As Range
Dim ColumnB As Range
Dim t As Variant
Application.ScreenUpdating = False
t = Timer
'Define name of worksheets
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
'First string(Header of Column) to find on ws1
FindString = "Inventory date (YYYY-MM-DD)"
If Trim(FindString) <> "" Then
Set Rng = ws1.Cells.Find(What:=FindString, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Rng = FindString Then
Application.Goto Rng.Offset(1, 0), True
'Get the last used row in column
Set lastRow = Cells.Find(What:="", After:=[ActiveCell], SearchOrder:=xlByColumns, SearchDirection:=xlDown)
Application.Goto Range(ActiveCell, lastRow.Offset(-1, 0))
'Copy data from Rng to lastRow
Selection.Copy
Else
MsgBox "Nothing found"
End If
End If
'Find second Header on ws2
ws2.Activate
If Cells.Find("W2W Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=True).Activate Then
ActiveCell.Offset(2, 0).PasteSpecial
Application.CutCopyMode = False
Else
Application.CutCopyMode = False
MsgBox "Nothing found"
End If
Application.ScreenUpdating = True
MsgBox "Time: " & Format(Timer - t, "00.00") & " seconds."
End Sub
Bookmarks