• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy and Paste Data form Multiple sheets to one sheet

J

jawaharprm

Member
Hi,
i trying to copy required column's to one to sheet to main sheet one after one but i getting error while pasting the sheet2 "DQ" at the lastrow of main sheet "Fields" pls help on same.

i enclosed file and code for your reference

Code: 
Option Explicit

Sub ITS_Allocation()
Dim lr1 As Long
Dim LastRow As Long

lr1 = Sheets("MDS").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("MDS").Range("B2:B" & lr1).Copy Sheets("Fields").Range("B2")
Sheets("MDS").Range("E2:E" & lr1).Copy Sheets("Fields").Range("C2")
Sheets("MDS").Range("F2:F" & lr1).Copy Sheets("Fields").Range("D2")
Sheets("MDS").Range("D2:D" & lr1).Copy Sheets("Fields").Range("E2")
Sheets("MDS").Range("G2:G" & lr1).Copy Sheets("Fields").Range("F2")
Sheets("MDS").Range("H2:H" & lr1).Copy Sheets("Fields").Range("G2")
Sheets("MDS").Range("J2:J" & lr1).Copy Sheets("Fields").Range("H2")
Sheets("MDS").Range("K2:K" & lr1).Copy Sheets("Fields").Range("I2")
Sheets("MDS").Range("I2:I" & lr1).Copy Sheets("Fields").Range("J2")

Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row).Value = "MDS"

LastRow = Sheets("Fields").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("DQ").Range("B:B" & lr1).Copy Sheets("Fields").Range("B")
Sheets("DQ").Range("D:D" & lr1).Copy Sheets("Fields").Range("C")
Sheets("DQ").Range("E:E" & lr1).Copy Sheets("Fields").Range("D")
Sheets("DQ").Range("C:C" & lr1).Copy Sheets("Fields").Range("E")
Sheets("DQ").Range("F:F" & lr1).Copy Sheets("Fields").Range("F")
Sheets("DQ").Range("G:G" & lr1).Copy Sheets("Fields").Range("G")
Sheets("DQ").Range("I:I" & lr1).Copy Sheets("Fields").Range("I")
Sheets("DQ").Range("K:K" & lr1).Copy Sheets("Fields").Range("I")

End Sub

thanks
jawahar r
 

Attachments

  • Const.xlsb
    71.5 KB · Views: 5
Maybe?:
Code: 
Sub ITS_Allocation()
Dim lr1 As Long
Dim lr2 As Long

lr1 = Sheets("MDS").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("MDS").Range("B2:B" & lr1).Copy Sheets("Fields").Range("B2")
Sheets("MDS").Range("E2:E" & lr1).Copy Sheets("Fields").Range("C2")
Sheets("MDS").Range("F2:F" & lr1).Copy Sheets("Fields").Range("D2")
Sheets("MDS").Range("D2:D" & lr1).Copy Sheets("Fields").Range("E2")
Sheets("MDS").Range("G2:G" & lr1).Copy Sheets("Fields").Range("F2")
Sheets("MDS").Range("H2:H" & lr1).Copy Sheets("Fields").Range("G2")
Sheets("MDS").Range("J2:J" & lr1).Copy Sheets("Fields").Range("H2")
Sheets("MDS").Range("K2:K" & lr1).Copy Sheets("Fields").Range("I2")
Sheets("MDS").Range("I2:I" & lr1).Copy Sheets("Fields").Range("J2")
Sheets("Fields").Range("A2:A" & lr1).Value = "MDS"

lr2 = Sheets("DQ").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("DQ").Range("B2:B" & lr2).Copy Sheets("Fields").Range("B" & lr1 + 1)
Sheets("DQ").Range("D2:D" & lr2).Copy Sheets("Fields").Range("C" & lr1 + 1)
Sheets("DQ").Range("E2:E" & lr2).Copy Sheets("Fields").Range("D" & lr1 + 1)
Sheets("DQ").Range("C2:C" & lr2).Copy Sheets("Fields").Range("E" & lr1 + 1)
Sheets("DQ").Range("F2:F" & lr2).Copy Sheets("Fields").Range("F" & lr1 + 1)
Sheets("DQ").Range("G2:G" & lr2).Copy Sheets("Fields").Range("G" & lr1 + 1)
Sheets("DQ").Range("I2:I" & lr2).Copy Sheets("Fields").Range("I" & lr1 + 1)
'Sheets("DQ").Range("K2:K" & lr2).Copy Sheets("Fields").Range("I" & lr1 + 1)'I think this is wrong.

'and maybe:
Sheets("Fields").Range("A" & lr1 + 1).Resize(lr2 - 1).Value = "DQ"
End Sub
 
p45cal said:
Maybe?:
Code: 
Sub ITS_Allocation()
Dim lr1 As Long
Dim lr2 As Long

lr1 = Sheets("MDS").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("MDS").Range("B2:B" & lr1).Copy Sheets("Fields").Range("B2")
Sheets("MDS").Range("E2:E" & lr1).Copy Sheets("Fields").Range("C2")
Sheets("MDS").Range("F2:F" & lr1).Copy Sheets("Fields").Range("D2")
Sheets("MDS").Range("D2:D" & lr1).Copy Sheets("Fields").Range("E2")
Sheets("MDS").Range("G2:G" & lr1).Copy Sheets("Fields").Range("F2")
Sheets("MDS").Range("H2:H" & lr1).Copy Sheets("Fields").Range("G2")
Sheets("MDS").Range("J2:J" & lr1).Copy Sheets("Fields").Range("H2")
Sheets("MDS").Range("K2:K" & lr1).Copy Sheets("Fields").Range("I2")
Sheets("MDS").Range("I2:I" & lr1).Copy Sheets("Fields").Range("J2")
Sheets("Fields").Range("A2:A" & lr1).Value = "MDS"

lr2 = Sheets("DQ").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("DQ").Range("B2:B" & lr2).Copy Sheets("Fields").Range("B" & lr1 + 1)
Sheets("DQ").Range("D2:D" & lr2).Copy Sheets("Fields").Range("C" & lr1 + 1)
Sheets("DQ").Range("E2:E" & lr2).Copy Sheets("Fields").Range("D" & lr1 + 1)
Sheets("DQ").Range("C2:C" & lr2).Copy Sheets("Fields").Range("E" & lr1 + 1)
Sheets("DQ").Range("F2:F" & lr2).Copy Sheets("Fields").Range("F" & lr1 + 1)
Sheets("DQ").Range("G2:G" & lr2).Copy Sheets("Fields").Range("G" & lr1 + 1)
Sheets("DQ").Range("I2:I" & lr2).Copy Sheets("Fields").Range("I" & lr1 + 1)
'Sheets("DQ").Range("K2:K" & lr2).Copy Sheets("Fields").Range("I" & lr1 + 1)'I think this is wrong.

'and maybe:
Sheets("Fields").Range("A" & lr1 + 1).Resize(lr2 - 1).Value = "DQ"
End Sub
Click to expand...
Hi Sir, Thank you for your time, it work's v nice, if i need to add more sheet i need do like this..
Code: 
lr3 = Sheets("BULK").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("BULK").Range("B2:B" & lr3).Copy Sheets("Fields").Range("B" & lr2 + 1)
Sheets("BULK").Range("D2:D" & lr3).Copy Sheets("Fields").Range("C" & lr2 + 1)

Sheets("Fields").Range("A" & lr2 + 1).Resize(lr3 - 1).Value = "BULK"

Thanks
Jawahar R
 
Hi Sir,
when i add new sheet and apply the mentioned code, the "DQ" sheet total data is 15000 but only 6000 has pasted, in "Fields" sheet,
but Sheet "MSD" and "Bulk" all data is pasted.

Code: 
Dim lr3 As Long
lr3 = Sheets("BULK").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

Sheets("BULK").Range("B2:B" & lr3).Copy Sheets("Fields").Range("B" & lr2 + 1)
Sheets("BULK").Range("D2:D" & lr3).Copy Sheets("Fields").Range("C" & lr2 + 1)
Sheets("BULK").Range("E2:E" & lr3).Copy Sheets("Fields").Range("D" & lr2 + 1)
Sheets("BULK").Range("C2:C" & lr3).Copy Sheets("Fields").Range("E" & lr2 + 1)
Sheets("BULK").Range("F2:F" & lr3).Copy Sheets("Fields").Range("F" & lr2 + 1)
Sheets("BULK").Range("G2:G" & lr3).Copy Sheets("Fields").Range("G" & lr2 + 1)
Sheets("BULK").Range("K2:K" & lr3).Copy Sheets("Fields").Range("I" & lr2 + 1)
Sheets("BULK").Range("I2:I" & lr3).Copy Sheets("Fields").Range("J" & lr2 + 1)

Sheets("Fields").Range("A" & lr2 + 1).Resize(lr3 - 1).Value = "BULK"

End Sub
 
Hi, check the values of variables lr2 & lr3 according to your issue (failing logic 'cause you forgot to update the last used row !) …​
​
 
According to the initial post attachment a beginner level Excel basics matching headers VBA demonstration​
checking any sheet after Sheet1 (FIELDS) :​
Code: 
Sub Demo1()
        Dim S&, R&, V, C%
   With Sheet1
       .UsedRange.Offset(1).EntireRow.Delete
        Application.ScreenUpdating = False
    For S = .Index + 1 To Sheets.Count
        R = .UsedRange.Rows.Count + 1
        V = Application.Match(Sheets(S).UsedRange.Rows(1), .UsedRange.Rows(1), 0)
    For C = 1 To UBound(V)
        If IsNumeric(V(C)) Then Sheets(S).UsedRange.Rows("2:" & Sheets(S).UsedRange.Rows.Count).Columns(C).Copy .Cells(R, V(C))
    Next
        If .UsedRange.Rows.Count >= R Then .Range("A" & R & ":A" & .UsedRange.Rows.Count) = Sheets(S).Name
    Next
   End With
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
​
 
jawaharprm said:
the "DQ" sheet total data is 15000 but only 6000 has pasted
Click to expand...
As Marc L said, check the value of lr2
Put a Stop instruction directly after the line:
Code: 
lr2 = Sheets("DQ").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Stop
run the code and it will stop there; then hover your mouse over lr2 and see what its value is.
 
The failing logic with lr2 is it belongs to DQ so very not to FIELDS obviously !​
This logic trap is avoided in my previous post VBA demonstration with R variable …​
​
 
Ah yes, I see, the lines should perhaps be more like (not tested):
Sheets("BULK").Range("B2:B" & lr3).Copy Sheets("Fields").Range("B" & lr1 + lr2 + 1)
@jawaharprm , how many sheets do you have to copy over like this? How did you get on with Marc L's code?
 
You must log in or register to reply here.
Back
Top