Shanaka Fernando
New Member
- Joined
- Sep 30, 2021
- Messages
- 12
- Office Version
- 2010
- Platform
- Windows
i have vba code for copy cell value from multiple sheet to one sheet based on header
i need to change the vba code to copy row value until first blank row
ex- need copy
header "Item description" until "women bikini 2p hang"
Sub MoveToDestination()
Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant
Dim ws As Worksheet, wsRow As Long, wsCol As Variant
Dim columnHeader As Variant
Set destinationSheet = ThisWorkbook.Worksheets("data")
For Each ws In ThisWorkbook.Worksheets
If Not ws Is destinationSheet Then
For Each columnHeader In Array("COLOR", "Item description")
With ws
wsCol = Application.Match(columnHeader, .Rows(17), 0)
If Not IsError(wsCol) Then
wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1
.Range(.Cells(18, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
Else
MsgBox "Column heading " & columnHeader & " not found in row 1 of " & .Name
End If
End With
Next
End If
Next
End Sub
i need to change the vba code to copy row value until first blank row
ex- need copy
header "Item description" until "women bikini 2p hang"
Sub MoveToDestination()
Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant
Dim ws As Worksheet, wsRow As Long, wsCol As Variant
Dim columnHeader As Variant
Set destinationSheet = ThisWorkbook.Worksheets("data")
For Each ws In ThisWorkbook.Worksheets
If Not ws Is destinationSheet Then
For Each columnHeader In Array("COLOR", "Item description")
With ws
wsCol = Application.Match(columnHeader, .Rows(17), 0)
If Not IsError(wsCol) Then
wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1
.Range(.Cells(18, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
Else
MsgBox "Column heading " & columnHeader & " not found in row 1 of " & .Name
End If
End With
Next
End If
Next
End Sub