Query: I want to copy data from two two sheets to third sheet, I have sheet 1 & sheet 2 having multiple columns & rows, some columns in both the sheet have same header, i want to copy few of them to third sheet. So match haeding in sheet 1 copy all data till last row and paste it to last sheet, same for sheet2. Copy data for all column header in last sheet.
Solution:
Make sure haeader in all sheet is similar & we can make macro to search through header in sheet 1/Sheet 2 & if header matches copy data from sheet 1 & paste it to last sheet.
Use below code:
Solution:
Make sure haeader in all sheet is similar & we can make macro to search through header in sheet 1/Sheet 2 & if header matches copy data from sheet 1 & paste it to last sheet.
Use below code:
Option Explicit Sub copy_data_from _two_sheets_to_Summary_sheet() Dim Rng As Range, c As Range Dim sCell As Range Dim rSize As Long Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet Set sh1 = Sheets("File 1") Set sh2 = Sheets("File 2") Set sh3 = ThisWorkbook.ActiveSheet sh3.[A2].Resize([A2].End(xlDown).Row - 1, 1).EntireRow.Clear Set Rng = sh3.Range([A1], [A1].End(xlToRight)) For Each c In Rng 'Copy data from Sheet 1 Set sCell = sh1.Range("1:1").Find(What:=c.Value, LookIn:=xlValues) If Not sCell Is Nothing Then rSize = sh1.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count If c.Offset(1, 0).Value <> "" Then c.End(xlDown).Offset(1, 0).Resize(rSize, 1).Value = sh1.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value Else c.Offset(1, 0).Resize(rSize, 1).Value = sh1.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value End If End If 'Copy data from Sheet 2 Set sCell = sh2.Range("1:1").Find(What:=c.Value, LookIn:=xlValues) If Not sCell Is Nothing Then rSize = sh2.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count If c.Offset(1, 0).Value <> "" Then c.End(xlDown).Offset(1, 0).Resize(rSize, 1).Value = sh2.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value Else c.Offset(1, 0).Resize(rSize, 1).Value = sh2.Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value End If End If Next MsgBox "Done" End Sub
Cheers!!
At the same time, shall be able|it is feasible for you to} to unlock a host of promotional deals and offers, including that all-important, lucrative welcome bonus. This can then be spent elsewhere on the site and is a fantastic start line in your journey. From right 메리트카지노 here, have the ability to|you possibly can} target increasingly lucrative games and offers, steadily build up your stability till you hit that coveted jackpot. A minimum deposit of $/€20 will be required to set off the bonus.
ReplyDelete