joostpost198
05-15-2013, 03:56 AM
I want to copy the workbook and worksheet name from the old into a new excel on every row of the first column. the vba text i have now is:
Public Sub get_spec_data()
Dim ws As Worksheet
Dim ws_d As Worksheet
Dim r_d As Long
Dim c_d As Long
Dim r As Long
Set ws = Workbooks("NG4A-DA-ITTDS-CD30195.xls").Worksheets("LC")
Set ws_d = ThisWorkbook.Worksheets("Spec_data")
ws.Activate
Debug.Print ws.Name
Debug.Print ws.PageSetup.PrintArea
r_d = 1
c_d = 1
r = 1
For Each c In ws.Range(ws.PageSetup.PrintArea).Cells
Debug.Print c.Address, c.Row, c.Value, r, Columns(c.Column).Hidden
If Trim(c.Value) <> "" And Not Columns(c.Column).Hidden Then
Debug.Print "Ja ik heb een niet lege cell gevonden"
If c.Row = r Then
c_d = c_d + 1
Else
r_d = r_d + 1
c_d = 2
End If
ws_d.Cells(r_d, c_d).Value = c.Value
End If
r = c.Row
Next
End Sub
Public Sub get_spec_data()
Dim ws As Worksheet
Dim ws_d As Worksheet
Dim r_d As Long
Dim c_d As Long
Dim r As Long
Set ws = Workbooks("NG4A-DA-ITTDS-CD30195.xls").Worksheets("LC")
Set ws_d = ThisWorkbook.Worksheets("Spec_data")
ws.Activate
Debug.Print ws.Name
Debug.Print ws.PageSetup.PrintArea
r_d = 1
c_d = 1
r = 1
For Each c In ws.Range(ws.PageSetup.PrintArea).Cells
Debug.Print c.Address, c.Row, c.Value, r, Columns(c.Column).Hidden
If Trim(c.Value) <> "" And Not Columns(c.Column).Hidden Then
Debug.Print "Ja ik heb een niet lege cell gevonden"
If c.Row = r Then
c_d = c_d + 1
Else
r_d = r_d + 1
c_d = 2
End If
ws_d.Cells(r_d, c_d).Value = c.Value
End If
r = c.Row
Next
End Sub