PDA

View Full Version : Macro to copy data from different cells and paste in new sheet



aravindhan_3
01-12-2014, 08:21 AM
Hi, I have a 20 sheets in a workbook, I need to collate data for those 20 sheets in to my master sheet.value from cells A5 and paste in Master sheet A2Values from Cell A24 and paste in Master Sheet B2Values from Cell B85 and paste in Master sheet C2 the data has to be copied from all 20 sheets and paste in master sheet one below the other. Can you please help me to write a code to copy these values to my new file?RegardsArvind

Bob Phillips
01-12-2014, 08:31 AM
Off the top


Public Sub CopyData()
Dim nextrow As Long

With Worksheets("Master")

nextrow = 2
For Each sh In ThisWorkbook.Worksheets

If Not sh.Name = "Master" Then

sh.Range("A5").Copy .Cells(nextrow, "A")
sh.Range("A24").Copy .Cells(nextrow, "B")
sh.Range("B85").Copy .Cells(nextrow, "C")

nextrow = nextrow + 1
End If
Next sh
End With
End Sub

aravindhan_3
01-12-2014, 08:52 AM
Thanks!it works, need little changeI need to udpate in master sheet by i want to take data from all worksheets except sheets "Guide" and "Info"RegardsArvind

SamT
01-13-2014, 10:09 AM
With xld's code

If Not (sh.Name = "Master") Or (sh.name = "guide") Or (sh.name = "Info") Then

Alternately, especially if you might have many sheets excluded. (This is mostly xld's code)

Option Explicit

Public Sub CopyData()
Dim nextrow As Long
Dim UseSheets As New Scripting.Dictionary
Dim Sht As Worksheet

For Each Sht In Sheets 'Set to use all sheets
UseSheets.Add Sht.Name, "True"
Next Sht
With UseSheets 'Set sheets to not use
.Item("Master") = "False"
.Item("Guide") = "False"
.Item("Info") = "False"
End With

With Worksheets("Master")
nextrow = 2
For Each Sht In ThisWorkbook.Worksheets

If UseSheets(Sht.Name) Then

Sht.Range("A5").Copy .Cells(nextrow, "A")
Sht.Range("A24").Copy .Cells(nextrow, "B")
Sht.Range("B85").Copy .Cells(nextrow, "C")

nextrow = nextrow + 1
End If
Next Sht
End With
End Sub

aravindhan_3
01-14-2014, 11:38 PM
Great It works :)I tried in a new workbook and it worked file name ("Master")

Sub CopyData()
Dim nextrow As Long
Dim sh As Worksheet
With Worksheets("Master")
Windows("file 1.xlsx").Activate
nextrow = Range("A" & Rows.Count).End(xlUp).Row + 1
For Each sh In ThisWorkbook.Worksheets
If Not (sh.Name = "Master") Then
Cells(nextrow, "B").Value = sh.Range("B3").Value
Cells(nextrow, "C").Value = sh.Range("C3").Value
Cells(nextrow, "D").Value = sh.Range("E3").Value
Cells(nextrow, "E").Value = sh.Range("B5").Value
Cells(nextrow, "F").Value = sh.Range("B7").Value
Cells(nextrow, "G").Value = sh.Range("C7").Value
Cells(nextrow, "K").Value = sh.Range("B47").Value
Cells(nextrow, "L").Value = sh.Range("B46").Value
Cells(nextrow, "M").Value = sh.Range("B11").Value
Cells(nextrow, "N").Value = sh.Range("B9").Value
Cells(nextrow, "O").Value = sh.Range("C37").Value
Cells(nextrow, "P").Value = sh.Range("E37").Value
Cells(nextrow, "Q").Value = sh.Range("B14").Value
Cells(nextrow, "R").Value = sh.Range("B17").Value
Cells(nextrow, "T").Value = sh.Range("E19").Value
Cells(nextrow, "V").Value = sh.Range("B20").Value
Cells(nextrow, "W").Value = sh.Range("B21").Value
Cells(nextrow, "Y").Value = sh.Range("B22").Value
Cells(nextrow, "Z").Value = sh.Range("B23").Value
Cells(nextrow, "AA").Value = sh.Range("B24").Value
Cells(nextrow, "AB").Value = sh.Range("B25").Value
Cells(nextrow, "AD").Value = sh.Range("B27").Value
Cells(nextrow, "AE").Value = sh.Range("C27").Value
Cells(nextrow, "AF").Value = sh.Range("E27").Value
Cells(nextrow, "AG").Value = sh.Range("C29").Value
Cells(nextrow, "AH").Value = sh.Range("E29").Value
Cells(nextrow, "AI").Value = sh.Range("B29").Value
Cells(nextrow, "AO").Value = sh.Range("B30").Value
Cells(nextrow, "AP").Value = sh.Range("B36").Value
Cells(nextrow, "AQ").Value = sh.Range("B40").Value
Cells(nextrow, "AR").Value = sh.Range("B41").Value
Cells(nextrow, "AS").Value = sh.Range("B42").Value
Cells(nextrow, "AU").Value = sh.Range("C43").Value
Cells(nextrow, "AV").Value = sh.Range("E43").Value
Cells(nextrow, "AY").Value = sh.Range("C45").Value
Cells(nextrow, "AZ").Value = sh.Range("B45").Value
Cells(nextrow, "BA").Value = sh.Range("E45").Value
Cells(nextrow, "BD").Value = sh.Range("B34").Value
Cells(nextrow, "BE").Value = sh.Range("B39").Value
Cells(nextrow, "BF").Value = sh.Range("C52").Value
Cells(nextrow, "BG").Value = sh.Range("C36").Value
nextrow = nextrow + 1
End If
Next sh
End With
End Sub

I have another macro which collates these data, so i have plugged the above code in my code below

Sub Collation()
Dim wbNew As Workbook
Dim wsRpt As Worksheet:
Set wsRpt = ThisWorkbook.Sheets("Collation")
Dim NR As Long
Dim LR As Long
Dim fPath As String:
fPath = "C:\Documents and Settings\mt45\Desktop\New line form\Forms\"'fPath = ThisWorkbook.Sheets("Macro").Range("B2").Value & "\"
Dim fName As String'Option to clear existing report
Sheets("Collation").Select
NR = Range("B" & Rows.Count).End(xlUp).Row + 1
'Start import loop
fName = Dir(fPath & "*.xls")
Do While Len(fName) > 0
'open file
Application.DisplayAlerts = False
Set wbNew = Workbooks.Open(fPath & fName)
' Collation macro
Dim nextrow As Long
Dim sh As Worksheet
With Worksheets("Master")
Windows("file 1.xlsx").Activate
nextrow = Range("A" & Rows.Count).End(xlUp).Row + 1
For Each sh In ThisWorkbook.Worksheets
If Not (sh.Name = "Master") Then
Cells(nextrow, "B").Value = sh.Range("B3").Value
Cells(nextrow, "C").Value = sh.Range("C3").Value
Cells(nextrow, "D").Value = sh.Range("E3").Value
Cells(nextrow, "E").Value = sh.Range("B5").Value
Cells(nextrow, "F").Value = sh.Range("B7").Value
Cells(nextrow, "G").Value = sh.Range("C7").Value
Cells(nextrow, "K").Value = sh.Range("B47").Value
Cells(nextrow, "L").Value = sh.Range("B46").Value
Cells(nextrow, "M").Value = sh.Range("B11").Value
Cells(nextrow, "N").Value = sh.Range("B9").Value
Cells(nextrow, "O").Value = sh.Range("C37").Value
Cells(nextrow, "P").Value = sh.Range("E37").Value
Cells(nextrow, "Q").Value = sh.Range("B14").Value
Cells(nextrow, "R").Value = sh.Range("B17").Value
Cells(nextrow, "T").Value = sh.Range("E19").Value
Cells(nextrow, "V").Value = sh.Range("B20").Value
Cells(nextrow, "W").Value = sh.Range("B21").Value
Cells(nextrow, "Y").Value = sh.Range("B22").Value
Cells(nextrow, "Z").Value = sh.Range("B23").Value
Cells(nextrow, "AA").Value = sh.Range("B24").Value
Cells(nextrow, "AB").Value = sh.Range("B25").Value
Cells(nextrow, "AD").Value = sh.Range("B27").Value
Cells(nextrow, "AE").Value = sh.Range("C27").Value
Cells(nextrow, "AF").Value = sh.Range("E27").Value
Cells(nextrow, "AG").Value = sh.Range("C29").Value
Cells(nextrow, "AH").Value = sh.Range("E29").Value
Cells(nextrow, "AI").Value = sh.Range("B29").Value
Cells(nextrow, "AO").Value = sh.Range("B30").Value
Cells(nextrow, "AP").Value = sh.Range("B36").Value
Cells(nextrow, "AQ").Value = sh.Range("B40").Value
Cells(nextrow, "AR").Value = sh.Range("B41").Value
Cells(nextrow, "AS").Value = sh.Range("B42").Value
Cells(nextrow, "AU").Value = sh.Range("C43").Value
Cells(nextrow, "AV").Value = sh.Range("E43").Value
Cells(nextrow, "AY").Value = sh.Range("C45").Value
Cells(nextrow, "AZ").Value = sh.Range("B45").Value
Cells(nextrow, "BA").Value = sh.Range("E45").Value
Cells(nextrow, "BD").Value = sh.Range("B34").Value
Cells(nextrow, "BE").Value = sh.Range("B39").Value
Cells(nextrow, "BF").Value = sh.Range("C52").Value
Cells(nextrow, "BG").Value = sh.Range("C36").Value
nextrow = nextrow + 1
End If
Next sh
End With

LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:P" & LR).Select
Selection.Copy
wsRpt.Range("B" & NR).PasteSpecial xlPasteValues
wsRpt.Range("A" & NR).Value = wbNew.Name
wbNew.Activate
'close
Application.CutCopyMode = False
Range("A1").Select
ActiveWindow.Close False
'next loop
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
fName = Dir
Loop
End Sub

what i need is, when run this Copy data macro, it opens all the files in the folder, and when it opens it run the collation macro you did and then takes the data from master file.I checked it, for some reason its not takign values from "Master workbook" but from "Collation" workbook something like With this workbook to be added, i am not sure where to plug this. Can you helpArvind

Aussiebear
01-15-2014, 12:31 AM
I have edited your latest post so that it is readable, something that you should have done rather than leave the mess it was. Please remember, that you are asking for assistance, so make your post as readable as possible otherwise others will simply skip over the thread. For further posts which may include sections of code please use Code surrounded by square brackets, your code then /Code surrounded by square brackets and there is no need to include rows of "================== to indicate any spaces. To edit any post that you may have inaccurately posted, click on the Edit Post. You need to do so as quickly as possible as there is a time limit.