Columns to columns

[doug5jmp]

I have a data list

Item List 4/07/10 Blank 04/15/10 Blank YTD
Soap 3 Blank 2 5
Tp 3 Blank 3 6
PT 5 4 9

Each week a new date and amount is entered, and the sum for YTD is updated. I would like to copy only those columns that have a date entered and the YTD, to another worksheet with the same item list. The problem is when I select the range I end up with the blank columns as well. This has to be dynamic and have the new date and item numbers (column) update and be placed into the new worksheet when they are entered in the current worksheet. Note...The documents will be separate excel wkbks.

I am a novice and not sure what to do.

 

[doug5jmp]

Item List______4/07/10________Blank_________04/15/10________Blank________YTD
Soap[__________3____________Blank___________2[____________Blank_________5
Tp ____________3____________Blank___________3_____________Blank_________6
PT____________2____________Blank___________4_____________Blank_________6

This is easier to see

 

[snowblizz]

You want something along these lines. It works on a basic level.

Sub datacopy()
Set ListSht = Sheets("Sheet3")
Set DataSht = ActiveSheet
ListSht.UsedRange.ClearContents
LastCol = DataSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

DataSht.Columns(1).Copy ListSht.Columns(1)

For Col = 2 To LastCol
LastCol2 = ListSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    If DataSht.Cells(1, Col).Value <> "" Then
    DataSht.Columns(Col).Copy
    ListSht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
    End If
Next Col
Application.CutCopyMode = False
End Sub

 

[doug5jmp]

Being that I am a novice...I..
alt f11
copy paste code
run with f5

I do this on the new workbook or the one with the data?
In the end I have 3 more wkbks with the same list and want to do exactly the same thing.

Where to I list all of the wkbks/wkshts? in the code so that the new workbk/wkst has all 4 listings?

AND how to order them in the columns?

My goal is to get all the information in one sheet so I can easily run reports. At work I only have 2003 office and am plugging away at getting every bit of information into a much needed report. I need All dates listed in order by each of the 4 locations and sum up each location and total all locations...And when each locations updates the report would have to add the dates etc.

 

[snowblizz]

The code is run from the source workbook and source sheet. Though now that its fully qualified it is not technically necessary.
I'll try to explain the code and then we'll see what we can do.

Sub datacopy()
Set DataSht = Workbooks("Sourceworkbook").Sheets("Sourcesheet") 'source sheet
Set ListSht = Workbooks("Destination workbook").Sheets("Sheet3") 'destination sheet

ListSht.UsedRange.ClearContents  'empties the destination sheet
LastCol = DataSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'finds the last used column in source sheet

DataSht.Columns(1).Copy ListSht.Columns(1) 'copies "headers", basically Column A, from source to destination

For Col = 2 To LastCol 'loops through all columns in source sheet from column B to the last column used
LastCol2 = ListSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'finds last used column in destination
    If DataSht.Cells(1, Col).Value <> "" Then 'test for an empty column, assumes any column with empty cell in row 1 is empty
    DataSht.Columns(Col).Copy 'copies whole column
    ListSht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats) 'pastes numbers and formats to the destination sheet
    End If
Next Col
Application.CutCopyMode = False
End Sub

However, do I understand that you want to have data from multiple workbooks that you want consolidated into one? That makes it a lot trickier unfortunately. Right now it avoids the whole mess of finding out which is "new" column by just re-copying everything each time.

But would it be true that the last column is always YTD and the "new" column is always the last one before (with data).

 

[doug5jmp]

that is correct....multiple and the new and ytd...you are getting what I am looking for...
it is essentially looking for each location, and how many items were taken as physical inventory on a given date. Than combing each inventory location and update with last new column before YTD

 

[snowblizz]

I've got it this far right now.

Excel Workbook
	A	B	C	D	E	F
1	Item List	4.7.2010		04/15/10		YTD
2	Soap	3		2		5
3	Tp	3		3		6
4	PT	5		4		9
Sheet1

Excel Workbook
	A	B	C	D	E	F
1	Item List	4.3.2010		4.12.2010		YTD
2	Soap	3		2		5
3	Tp	3		3		6
4	PT	5		4		9
Excel 2003 Sheet2

Excel Workbook
	A	B	C	D	E
1	Item List	4.7.2010	04/15/10	4.3.2010	4.12.2010
2	Soap	3	2	3	2
3	Tp	3	3	3	3
4	PT	5	4	5	4
Excel 2003 Sheet3

Excel 2003

Now in the items list will all items exist, and on the same row, for each separate location?
(YTD sum formula and sorting not fixed yet though.)

 

[snowblizz]

This should now be close.
It needs to be run from a code module. I suggest placing the code module in the destination workbook. Referenced workbooks need to be open.
It copies the last data column before YTD on the assumption that this is the newest one.

Sub datacopy()
Set ListSht = Workbooks("Book1").Sheets("Sheet3") 'destination sheet
Dim sheetArray()
WkBArray = Array(Workbooks("Book1").Sheets("Sheet1"), Workbooks("Book1").Sheets("Sheet2")) 'add source sheets here

For Each wkB In WkBArray 'loop through all listed sheets
Set DataSht = wkB

LastCol = DataSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCol2 = ListSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    DataSht.Columns(LastCol - 2).Copy
    ListSht.Columns(LastCol2 + 1).PasteSpecial (xlPasteValuesAndNumberFormats)

Next
Application.CutCopyMode = False
LastCol2 = ListSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastRow = ListSht.Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
 With ListSht
 .Range(.Cells(1, 2), .Cells(LastRow, LastCol2)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
If .Cells(1, LastCol2).Value = "YTD" Then
i = 0
j = -1
Else
.Cells(1, LastCol2 + 1).Value = "YTD"
i = 1
j = 0
End If
.Range(.Cells(2, LastCol2 + i), .Cells(LastRow, LastCol2 + i)).FormulaR1C1 = "=SUM(R" & Row & "C2:R" & Row & "C" & LastCol2 + j & ")"
End With
End Sub

 

[doug5jmp]

Yes all Items in the Item list can be the same and in the same location. Though there are a couple of items that would not be in atwo locations(workbooks) BUT I can enter them and just have each location the does not use those items place a "0" if need be.

When the code is ran all sheets have to be open. Though will the destination workbk/worksheet update when it is opened by itself? All files, wkbks and wkshts are saved in the same drive on a server that is used by all locations.

THANK YOU...

 

[doug5jmp]

I am not sure what the code module is. Can you show in your code that: There are 4 wkbks are using wksheet 1 AND 1 wkbk with 5 wkshts.
And exactly how to input the code module on the destination worksheet.