Hi, can the code below be revised to find the last row up to a cell with a specific word, "FABRIC", in column A? I have a variable section I want to copy but it has blank rows separating portions of it, so the find last row stops at the first blank line. Below is a snapshot of my table.
Thanks
Sub TOT_FAB()
Application.ScreenUpdating = False
Range("A8:C" & Range("A8").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets("PARTS LIST")).name = "TOT FAB"
Worksheets("TOT FAB").Range("A3").PasteSpecial Paste:=xlPasteFormulas
Range("C:C").Select
Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="X", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("E3").Select
Columns("A:A").AutoFit
Columns("B:B").HorizontalAlignment = xlCenter
Columns("C:E").HorizontalAlignment = xlLeft
Columns("B:B").ColumnWidth = 5
Columns("C:D").ColumnWidth = 6
Range("A1") = "DESCRIPTION"
Range("B1") = "QUA"
Range("C1") = "WID"
Range("D1") = "LEN"
Application.ScreenUpdating = True
End Sub
Thanks
Sub TOT_FAB()
Application.ScreenUpdating = False
Range("A8:C" & Range("A8").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets("PARTS LIST")).name = "TOT FAB"
Worksheets("TOT FAB").Range("A3").PasteSpecial Paste:=xlPasteFormulas
Range("C:C").Select
Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="X", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("E3").Select
Columns("A:A").AutoFit
Columns("B:B").HorizontalAlignment = xlCenter
Columns("C:E").HorizontalAlignment = xlLeft
Columns("B:B").ColumnWidth = 5
Columns("C:D").ColumnWidth = 6
Range("A1") = "DESCRIPTION"
Range("B1") = "QUA"
Range("C1") = "WID"
Range("D1") = "LEN"
Application.ScreenUpdating = True
End Sub
VBA Code: