'Finds the last non-blank cell in a single row or column
Dim myFile As String, cellValue As Variant, i As Integer, j As Integer, a As Integer
Dim lRow As Long
Dim lCol As Long
Dim Cell_val As String
Dim strFileToOpen As String
Dim WS_SheetName As String
Dim WS_Count As Integer
Dim temp_str As String
strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="Excel Files *.xls* (*.xls*),")
Workbooks.Open Filename:=strFileToOpen
Set Src_File = ActiveWorkbook
' MsgBox Len(strFileToOpen)
' MsgBox InStrRev(strFileToOpen, "\", Len(strFileToOpen))
temp_str = Right(strFileToOpen, (Len(strFileToOpen) - InStrRev(strFileToOpen, "\", Len(strFileToOpen))))
'MsgBox InStrRev(temp_str, ".", Len(temp_str))
temp_str = Left(temp_str, InStrRev(temp_str, ".", Len(temp_str)) - 1)
' Set WS_Count equal to the number of worksheets in the active workbook.
myFile = "C:\ExcelMacro\Create_" & temp_str & ".xls"
Open myFile For Output As #1
WS_Count = ActiveWorkbook.Worksheets.Count
For a = 1 To WS_Count
'Activating the Worksheet which will open according to the count
ActiveWorkbook.Worksheets(a).Activate
WS_SheetName = ActiveWorkbook.Worksheets(a).Name
'Check if it contains Table data
If UCase(Cells(1, 1)) = "TABLE NAME" Then
tbl_nme = UCase(Cells(1, 2).Value)
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(4, Columns.Count).End(xlToLeft).Column
End If
'Select A column data from cell A4 till last row with data
For i = 4 To lRow
For j = 1 To 3
cellValue = UCase(Cells(i, j).Value)
Print #1, tbl_nme & cellValue --------> some change needs to be done here.. i get the table name and cell value in same cell.. i want it in next column.
Next i
Next a
Close #1
End Sub
Related:
Need urgent help with spltng the data copied in another workbook
