Cleaning up repetitive VBA

[mssbass]

I have several lines of the same code which copies from several different worksheets - is there a way to clean this up a little?

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("Auto Provider")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("A3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("Future")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("D3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("Sleep - Attached")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("G3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("CGM")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("J3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("Diabetic Supplies")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("M3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("Breast Pumps")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("P3")

Set wsCopy = Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx").Worksheets("FL Blue Medicare")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
wsCopy.Range("H2:H" & lCopyLastRow).Copy _
wsDest.Range("S3")

 

[Fluff]

How about

   Dim Ary As Variant
   
   Ary = Array("Auto Provider", "A3", "Future", "D3", "Sleep - Attached", "G3")
   
   For i = 0 To UBound(Ary) Step 2
      With Workbooks("Staffing_Routing_Point_Open_Report_" & txtDate & ".xlsx")
         With .Sheets(Ary(i))
            .Range("H2:H" & .Range("A" & Rows.Count).End(xlUp).Row).Copy wsDest.Range(Ary(i + 1))
         End With
      End With
   Next i

 

[Joe4]

If it is ALL the sheets in your workbook, it is even easier. You can simply loop through all sheets (without having to store their names in an array). Something like:

Dim ws as Worksheet
For Each ws in Worksheets
    With ws
        'your code here
    End With
Next ws

 

[mssbass]

Worked great! Thank you for your help!!

 

[Fluff]

Glad we could help & thanks for the feedback