AW: automatisches Makro update?
Ansgar
Hi Daniel,
danke fuer die Antwort. Ich habe leider wirklich keine Ahnung von VBA und daher kann ich mit Deiner Antwort so noch nicht viel anfangen.
Wenn ich die neue
Sub generiere, laeuft die dann von alleine?
Was ist ByVal?
Vielleicht hilft es, wenn ich mal den Makro hier rein kopiere?
Das ist mein Makro bisher (und es hat mich schon lange genug gedauert, dieses sehr unelegante Teil zusammenzufriemeln...)
Falls einer die Musse hat, mir noch ein bisschen weiterzuhelfen, waere das genial...
Vielen Dank vorab,
Ansgar
Dim row_label As Integer
Dim col_label As Integer
Dim reset_row_label As Integer
Dim ID As Integer
Dim current_sheet As String
Dim paste_row As Integer
Sub transpose_data()
'Deletes current values from the table
Worksheets("SubProject Summary").Select
Rows("17:20000").Select
Selection.ClearContents
Range("a2").Select
paste_row = 17
ID = 1
'Start at Begin and move to first sheet in the series
Sheets("Begin").Select
ActiveSheet.Next.Select
Do While Not ActiveSheet.Name = "End"
'sets the activeworksheet to get data from
current_sheet = ActiveSheet.Name
'data constants to get from the active worksheet
subproject = ActiveSheet.Cells(9, 4)
'shows result worksheet so you can see data transfer
Worksheets("SubProject Summary").Select
'sets the set of data to copy
row_label = 57
'get the name of the SubProject
Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
Do While Not row_label = 58
For col_label = 6 To 32
'get relevant data and paste into "SubProject Summary" sheet
Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
Next col_label
row_label = 58
Loop
'move to next paste row
paste_row = paste_row + 1
'sets the next set of data to copy
row_label = 63
'get the name of the SubProject
Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
Do While Not row_label = 64
For col_label = 6 To 32
'get relevant data and paste into "SubProject Summary" sheet
Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
Next col_label
row_label = 64
Loop
'move to next paste row
paste_row = paste_row + 1
'sets the next set of data to copy
row_label = 68
'get the name of the SubProject
Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
Do While Not row_label = 69
For col_label = 6 To 32
'get relevant data and paste into "SubProject Summary" sheet
Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
Next col_label
row_label = 69
Loop
'move to next paste row
paste_row = paste_row + 1
'sets the next set of data to copy
row_label = 74
'get the name of the SubProject
Worksheets("SubProject Summary").Cells(paste_row, 5) = subproject
Do While Not row_label = 75
For col_label = 6 To 32
'get relevant data and paste into "SubProject Summary" sheet
Worksheets("SubProject Summary").Cells(paste_row, col_label) = Worksheets(current_sheet).Cells(row_label, col_label)
Next col_label
row_label = 75
Loop
'move to next paste row
paste_row = paste_row + 1
Worksheets(current_sheet).Select
ActiveSheet.Next.Select
Loop
Worksheets("SubProject Summary").Select
End Sub