vijkar2008
New Member
- Joined
- Feb 9, 2022
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
Hello!
I am new to vba coding and I need this macro to copy specific columns data consolidated from multiple sheets into one sheet.
Criteria :
1. Following are the column headers to search in multiple sheets - "Line of Business", "Tracking Numbers", "Legal Entity", "License", "Product", "Product Type", "Current Plan Code", "Plan Category", "Description", "Standards", "PCP Kids's Copay Designated Network", "Kid's Copay Age Limit Designated Network", "PCP Kid's Copay Network", "Kid's Copay Age Limit Network", "PCP Visit Limits", "URG CARE Visit Limits", "ER Visit Limits", "Acupuncture Copay", "Acupuncture Visit Limit", "Med/Rx Deductible Type", "Medical Deductible Type", "Market Code"
2. Copy multiple sheets data from source file matching above columns and paste (consolidated) to a separate workbook or on the destination sheet where I write macro.
3. I tried the below code where all data is copied from all sheets, but I couldn't figure out how to search and copy only specified columns. Also, I need to traverse multiple sheets until or before 'Rx Standards' sheet. I do not need anything from Rx Standards or sheets after it.
Private Sub CommandButton1_Click()
Workbooks.Open Filename:="C:\....\.....\.....\....\aaaaa.xlsx"
Worksheets.Add Sheets(1)
ActiveSheet.Name = "PH"
For A = 2 To Sheets.Count
Set xRg = Sheets(1).UsedRange
If A > 2 Then
Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
End If
Sheets(A).Activate
ActiveSheet.UsedRange.Copy xRg
Next
Application.ScreenUpdating = True
Worksheets("PH").Activate
MsgBox ("Done")
End sub
4. I tried another way where I have all the sheets in the same workbook where I write macro. Where I couldn't figure out a way to reset the Receiver array to point to the next blank row to copy data into. And so it overwrites the copied data to same position in the destination.
Private Sub CommandButton2_Click()
Dim Current As Worksheet, CR As Long
For Each Current In Worksheets
Dim Sht1 As Worksheet, Sht2 As Worksheet, FindRng As Range, Fnd As Range, Headers As Variant, Receivers As Variant, lR As Long
Headers = Array("Line of Business", "Tracking Numbers", "Legal Entity", "License", "Product", "Product Type", "Current Plan Code", "Plan Category", "Description", "Standards", "PCP Kids's Copay Designated Network", "Kid's Copay Age Limit Designated Network", "PCP Kid's Copay Network", "Kid's Copay Age Limit Network", "PCP Visit Limits", "URG CARE Visit Limits", "ER Visit Limits", "Acupuncture Copay", "Acupuncture Visit Limit", "Med/Rx Deductible Type", "Medical Deductible Type", "Market Code")
Receivers = Array("A3", "B3", "C3", "D3", "E3", "G3", "H3", "I3", "J3", "K3", "L3", "M3", "N3", "O3", "P3", "Q3", "R3", "S3", "T3", "U3", "V3", "W3")
Set Sht1 = Current: Set Sht2 = Sheets("PH")
Set FindRng = Intersect(Sht1.Rows(1), Sht1.Columns("A:ZZ"))
Application.ScreenUpdating = False
For I = LBound(Headers) To UBound(Headers)
Set Fnd = FindRng.Find(Headers(I))
If Not Fnd Is Nothing Then
lR = Sht1.Cells(Sht1.Rows.Count, Fnd.Column).End(xlUp).Row
Sht1.Range(Fnd, Sht1.Cells(lR, Fnd.Column)).Copy destination:=Sht2.Range(Receivers(I))
End If
Next I
Next
Application.ScreenUpdating = True
MsgBox ("Done")
End Sub
Please help me. I prefer the way mentioned in 3# where it creates separate workbook to avoid any data mess. I would appreciate any help. Thank you all for your help in advance!
I am new to vba coding and I need this macro to copy specific columns data consolidated from multiple sheets into one sheet.
Criteria :
1. Following are the column headers to search in multiple sheets - "Line of Business", "Tracking Numbers", "Legal Entity", "License", "Product", "Product Type", "Current Plan Code", "Plan Category", "Description", "Standards", "PCP Kids's Copay Designated Network", "Kid's Copay Age Limit Designated Network", "PCP Kid's Copay Network", "Kid's Copay Age Limit Network", "PCP Visit Limits", "URG CARE Visit Limits", "ER Visit Limits", "Acupuncture Copay", "Acupuncture Visit Limit", "Med/Rx Deductible Type", "Medical Deductible Type", "Market Code"
2. Copy multiple sheets data from source file matching above columns and paste (consolidated) to a separate workbook or on the destination sheet where I write macro.
3. I tried the below code where all data is copied from all sheets, but I couldn't figure out how to search and copy only specified columns. Also, I need to traverse multiple sheets until or before 'Rx Standards' sheet. I do not need anything from Rx Standards or sheets after it.
Private Sub CommandButton1_Click()
Workbooks.Open Filename:="C:\....\.....\.....\....\aaaaa.xlsx"
Worksheets.Add Sheets(1)
ActiveSheet.Name = "PH"
For A = 2 To Sheets.Count
Set xRg = Sheets(1).UsedRange
If A > 2 Then
Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
End If
Sheets(A).Activate
ActiveSheet.UsedRange.Copy xRg
Next
Application.ScreenUpdating = True
Worksheets("PH").Activate
MsgBox ("Done")
End sub
4. I tried another way where I have all the sheets in the same workbook where I write macro. Where I couldn't figure out a way to reset the Receiver array to point to the next blank row to copy data into. And so it overwrites the copied data to same position in the destination.
Private Sub CommandButton2_Click()
Dim Current As Worksheet, CR As Long
For Each Current In Worksheets
Dim Sht1 As Worksheet, Sht2 As Worksheet, FindRng As Range, Fnd As Range, Headers As Variant, Receivers As Variant, lR As Long
Headers = Array("Line of Business", "Tracking Numbers", "Legal Entity", "License", "Product", "Product Type", "Current Plan Code", "Plan Category", "Description", "Standards", "PCP Kids's Copay Designated Network", "Kid's Copay Age Limit Designated Network", "PCP Kid's Copay Network", "Kid's Copay Age Limit Network", "PCP Visit Limits", "URG CARE Visit Limits", "ER Visit Limits", "Acupuncture Copay", "Acupuncture Visit Limit", "Med/Rx Deductible Type", "Medical Deductible Type", "Market Code")
Receivers = Array("A3", "B3", "C3", "D3", "E3", "G3", "H3", "I3", "J3", "K3", "L3", "M3", "N3", "O3", "P3", "Q3", "R3", "S3", "T3", "U3", "V3", "W3")
Set Sht1 = Current: Set Sht2 = Sheets("PH")
Set FindRng = Intersect(Sht1.Rows(1), Sht1.Columns("A:ZZ"))
Application.ScreenUpdating = False
For I = LBound(Headers) To UBound(Headers)
Set Fnd = FindRng.Find(Headers(I))
If Not Fnd Is Nothing Then
lR = Sht1.Cells(Sht1.Rows.Count, Fnd.Column).End(xlUp).Row
Sht1.Range(Fnd, Sht1.Cells(lR, Fnd.Column)).Copy destination:=Sht2.Range(Receivers(I))
End If
Next I
Next
Application.ScreenUpdating = True
MsgBox ("Done")
End Sub
Please help me. I prefer the way mentioned in 3# where it creates separate workbook to avoid any data mess. I would appreciate any help. Thank you all for your help in advance!