Avinash Crap Pending sorting out

[DocAElstein]

Hi,

I think maybe you have got something mixed up or wrong….

The macro you posted seems unnecessarily very complicate. It may be complicated for reasons and issues that I do not know about. That is why , as ever, it is always important for me to know where you got the macro from
Where did you get this macro from?
Are you sure that your explanation is correct? I think that is probably not what you want. If it is then that macro you posted is probably not the one that you meant to…


Copy column B data of 1.xls and paste it to column C of basketorder.xlsx(exclude the header of column B of 1.xls and simply paste the rest data to column C of basketorder.xlsx
= copy 1.xls B2:B5 to C1:C4 BasketOrder.xlsx

If that is what you want , then you need just one code line like

' https://excelfox.com/forum/showthrea...ll=1#post14104
Ws2.Range(“C1:C4”).Value = Ws1.Range(“B2:B5”)

Or like

' https://excelfox.com/forum/showthrea...ll=1#post14100
Ws1.Range(“B2:B5”).Copy
Ws2.Range(“C1:C4”) .PasteSpecial Paste:= xlPasteValues


That you have been doing that now for 2 years, here one example https://excelfox.com/forum/showthrea...ll=1#post14104
https://excelfox.com/forum/showthrea...ll=1#post14100 .
I and others have shown you how to do that 100 times.
( And you just need to make the last row dynamic)



Alan

Sub DimPigSht4Brains1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set Ws2 = Workbooks("BasketOrder.xlsx").Worksheets.Item(1)
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
 Let Ws2.Range("C1:C4").Value = Ws1.Range("B2:B5").Value
End Sub



Sub DimPigSht4Brains2()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set Ws2 = Workbooks("BasketOrder.xlsx").Worksheets.Item(1)
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
 Ws1.Range("B2:B5").Copy
 Ws2.Range("C1:C4").PasteSpecial Paste:=xlPasteValues
End Sub

[fixer]

Yes i tried by both methods but i am unable to solve it
I tried by the code also which u shared the link & it was similar to this but there is small change between both macros & i am unable to solve the same
So plz help

Sub DimPigSht4Brains1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
 Set Ws1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample1.xls").Worksheets.Item(1): Set Ws2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample2.xlsx").Worksheets.Item(1)
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
 Let Ws2.Range("C:C").Value = Ws1.Range("B2:B").Value
End Sub

[DocAElstein]

You don’t seem to have read or understood anything I wrote, and your last reply is total rubbish and nonsense.
Go back to post 2, https://excelfox.com/forum/showthrea...ll=1#post14665 , take your time, and try again

I am not going to keep wasting my time saying the same thing over and over again! , and think before you post! , - don’t just post any rubbish and nonsense in the hope that we will magically guess what it is you want

[DocAElstein]

I got this macro in 2019 & I have not remebered from which forum i got this macro

So look for it and find it

[DocAElstein]

I got this macro in 2019 & I have not remebered from which forum i got this macro

So look for it and find it

[fixer]

http://www.eileenslounge.com/viewtopic.php?f=30&t=34998

[fixer]

http://www.eileenslounge.com/viewtopic.php?f=30&t=34996

[fixer]

Sub STEP7()
    Dim Wb1 As Workbook
    Dim wb3 As Workbook
    Dim Ws1 As Worksheet
    Dim ws3 As Worksheet
    Dim r As Long
    Dim m As Long
    Dim rng As Range
    Dim n As Long
    Application.ScreenUpdating = False
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Ws1 = Wb1.Worksheets(1)
    m = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
    Set wb3 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\BasketOrder.xlsx")
    Set ws3 = wb3.Worksheets(1)
    Set rng = ws3.Range("C:C").Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
    If rng Is Nothing Then
        n = 1
    Else
        n = rng.Row + 1
    End If
    For r = 2 To m
        ws3.Range("C" & n).Value = Ws1.Range("B" & r).Value
        n = n + 1
    Next r
    Application.DisplayAlerts = False
    wb3.Close SaveChanges:=True
    Wb1.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Problem Solved
Thnx Alot Doc Sir for helping me in solving this Problem
Have a Great Day

[fixer]

This Problem is Already Solved

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 = ""
    Wb.Save
    Wb.Close
    Next Stear
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

[fixer]

Problem Solved
Thnx Alot Doc Sir for helping me in solving this Problem
Have a Awesome Day