This week I want to demonstrate an efficient method for transferring desired data fields from one workbook to another without needing to manually copy/paste the data. This method will particularly come in handy in large spreadsheets where many columns need to be transferred. The data set below contains product categories for a retail store and the daily sales for each category. The goal is to transfer the fields belonging to the Clothing categories (i.e. Womenswear, Sportswear, Swimsuits, and Footwear) from the “All Products” tab to the “Apparel” tab. Here are the steps: STEP 1] copy paste the name of the desired fields (i.e. Date, Womenswear, Sportswear, Swimsuits, and Footwear) into the second tab. Spelling musty be exactly the same. STEP 2] copy and paste the macro below into the module tab of the VBA editor. Sub FieldLookup() Dim Sht1 As Worksheet, Sht2 As Worksheet Dim Sht1Head As Range, Sht2Head As Range Dim Header1 As Range, Header2 As Range Dim Counter As Integer Counter = 1 Set Sht1 = Sheets("Apparel") Set Sht2 = Sheets("All Products") Dim lastCol As Long Application.ScreenUpdating = False 'Headers from the first sheet-starting from cell A1 lastCol = Sht1.Cells(1, Columns.Count).End(xlToLeft).Column Set Sht1Head = Sht1.Range("A1", Sht1.Cells(1, lastCol)) ' Headers from the second sheet-starting from cell A1 lastCol = Sht2.Cells(1, Columns.Count).End(xlToLeft).Column Set Sht2Head = Sht2.Range("A1", Sht2.Cells(1, lastCol)) 'actually loop through and find values Do While Counter < 365 For Each Header2 In Sht2Head For Each Header1 In Sht1Head If Header2.Value = Header1.Value Then Header2.Offset(Counter, 0).Copy Header1.Offset(Counter, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False End If Next Header1 Next Header2 Counter = Counter + 1 Loop End Sub
Few very important note about this macro: First Note - Enter the name of the destination workbook on line 8 Set Sht1 = Sheets("Apparel") Second Note - enter the name of the source workbook on line 9 Set Sht2 = Sheets("All Products") Third Note - Enter the number of rows that you would like to be transfer on line 23 Do While Counter < 365 Here is the outcome in the second tab after the macro has been run:
0 Comments
Leave a Reply. |
CategoriesArchives
June 2020
|