Advertisement
Illustria

Untitled

Apr 24th, 2023 (edited)
46
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Function CopyColumnsByHeaders(SourceWorkbook As Workbook, SourceWorksheet As Worksheet, _
  2. destWorkbook As Workbook, destWorksheet As Worksheet, _
  3. startColumn As Long, ParamArray headers() As Variant)
  4.  
  5. Dim Header As Variant
  6. Dim sourceHeaderRange As Range
  7. Dim destHeaderRange As Range
  8. Dim lastUsedRow As Long
  9. Dim lastUsedColumn As Long
  10. Dim sourceLastRow As Long
  11. Dim destLastRow As Long
  12.  
  13. For Each Header In headers
  14.     Set sourceHeaderRange = SourceWorksheet.Rows(1).Find(Header, LookIn:=xlValues, LookAt:=xlWhole)
  15.  
  16.     If Not sourceHeaderRange Is Nothing Then
  17.         sourceLastRow = SourceWorksheet.Cells(SourceWorksheet.Rows.Count, sourceHeaderRange.Column).End(xlUp).Row
  18.         destLastRow = destWorksheet.Cells(destWorksheet.Rows.Count, startColumn).End(xlUp).Row + 1
  19.         SourceWorksheet.Range(SourceWorksheet.Cells(2, sourceHeaderRange.Column), SourceWorksheet.Cells(sourceLastRow, sourceHeaderRange.Column)).SpecialCells(xlCellTypeVisible).Copy _
  20.         Destination:=destWorksheet.Cells(destLastRow, startColumn)
  21.         startColumn = startColumn + 1
  22.     End If
  23. Next Header
  24. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement