Code:
Sub STEP8()
Dim arrWbs() As Variant
Let arrWbs() = Array("C:\Users\WolfieeeStyle\Desktop\A.xlsx", "C:\Users\WolfieeeStyle\Desktop\Files\B.xlsx")
Dim Wb As Workbook, Ws As Worksheet
Dim Stear As Variant
For Each Stear In arrWbs()
' 2a Worksheets data info
Set Wb = Workbooks.Open(Stear)
Set Ws = Wb.Worksheets.Item(1)
Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
Dim Cnt As Long
For Cnt = 1 To LrC
Dim strRws As String
If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
Next Cnt
Let strRws = Left(strRws, Len(strRws) - 1)
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
Dim Clms() As Variant
'
Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())
Ws.Cells.ClearContents
Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()
Let strRws = ""
Next Stear
arrWbs.Save 'Here we have to mention lineswhich will save the changes done by the macro, I tried by wb.save also & arrWbs.Save also but it was not correct
arrWbs.Close 'Here we have to mention lineswhich will close all the files opened by macro
End Sub
Public Function CL(ByVal lclm As Long) As String
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
Plz see the code & my remarks
I have mentioned the problem Doc Sir in the remarks
Bookmarks